Conditional Formatting Per-Row Color Scales

Conditional Formatting Per-Row Color Scales

If you want to compare all the numbers in a range, you can apply a conditional formatting color scale to the entire area and it works just fine. However, sometimes I want to compare the data on a per-row basis. Here’s two examples of data that could use per-row color scales:

same color scale throughout 11

The first, above, mixes values and percents. All the percents are red – the low end of the scale – because they equate to numbers between 0 and 1, and they’re getting compared to sales values between 1 and 100.

same color scale throughout 2

The second mixes sales from a large and small business. The sales for the small business are all shown as low – red – because they’re generally less than 1/100th of the sales of the large corporation.

In both cases I just want to compare the cells in each row to each other. Doing that, the second example looks like this, showing the relative sales within the company and year:

per row color scale 1

VBA to Apply Per-Row Color Scales

As far as I can tell, there’s no quick built-in way to apply color-scales (or icon sets or data bars) on a per-row basis. Instead you need to apply them one row at a time. So, of course, I wrote some VBA.

I’ve long been intimidated by Excel 2010’s conditional formatting object model, at least when it comes to non-formula conditions. But one day I answered this StackOverflow post about per-row color scales and decided to dig deeper.

For that answer I turned on the Macro Recorder, applied a color scale, and then called the generated code in a loop for each row. A better approach is to copy an existing row with the color scale you want and paste it over each row.

The simplest version of this is to copy all formatting in a source row and paste it to a target row. However, I’d prefer to grab only the color scale and paste it, ignoring other formats such as borders, text styles and other conditional formats.

If you turn on the Macro Recorder and apply a 3-gradient color scale to a range, you get something that looks like this, with the last five lines repeated two more times:

Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
    .Color = 7039480
    .TintAndShade = 0
End With

Note that it adds a ColorScale and then moves it to the top of the conditional formatting stack with SetFirstPriority.

I discovered a quirk when I tried to modify the above code to do some simple looping through the conditional formatting settings in a range. I tried something like this:

Dim fc As FormatCondition
For Each fc In Selection.FormatConditions
    Debug.Print fc.Application.Name
Next fc

That makes sense right? Set an object to a FormatCondition in order to loop through all the FormatConditions. However, if Selection only has color scale conditional formatting, you’ll get a “Type Mismatch” error on the “For Each fc” line. Turns out you need to declare fc as a ColorScale. Then the above code will run and will only cycle through the ColorScale objects.

So here’s the workhorse of my code. It’s called by the main module and loops through a target range, applying the color scale from the source range:

Sub SetRangeColorScale(rngTargetSection As Excel.Range, csSource As Excel.ColorScale)
Dim csTarget As ColorScale
Dim csCriterion As ColorScaleCriterion

Set csTarget = rngTargetSection.FormatConditions.AddColorScale(csSource.Type)
rngTargetSection.FormatConditions(rngTargetSection.FormatConditions.Count).SetFirstPriority
For Each csCriterion In csSource.ColorScaleCriteria
    With csTarget.ColorScaleCriteria(csCriterion.Index)
        .Type = csCriterion.Type
        .FormatColor.Color = csCriterion.FormatColor.Color
        .FormatColor.TintAndShade = csCriterion.FormatColor.TintAndShade
    End With
Next csCriterion
End Sub

Below is my main routine. It allows you to choose Row or Column orientation, so you can paste the color scales by-column if you wish. The SectionIncrement variable specifies how many rows at a time to paste the color scale, so you could apply the comparison over two or more rows (or columns) at a time.

Note that in this module, objSourceCondition is declared as an object and tested to see if it’s a ColorScale type of FormatCondition:

Sub CopyColorScaleInSections()
Dim rngSource As Excel.Range
Dim rngTarget As Excel.Range
Dim ws As Excel.Worksheet
Dim objSourceCondition As Object 'we'll test for ColorScale
Dim rngTargetSection As Excel.Range
Dim FillDirection As String
Dim IncompatibleRangeError As String
Dim SectionIncrement As Long
Dim SectionsCount As Long
Dim i As Long

'change the settings below to suit
Set ws = ActiveSheet
Set rngSource = ws.Range("B2:E2")
Set rngTarget = ws.Range("B3:E7")
FillDirection = "Rows"
SectionIncrement = 1

'deletes all existing formats
'you might want to change to just delete
'ColorScales, but for demo purposes
'this works well
rngTarget.FormatConditions.Delete
'checks whether the settings above work together
If Not CompatibleRanges(rngSource, rngTarget, SectionIncrement, _
        FillDirection, IncompatibleRangeError) Then
    MsgBox IncompatibleRangeError, vbOKOnly + vbExclamation
    GoTo exit_point
End If

'determine how many sections of rows or columns
'we'll be pasting over
If FillDirection = "Rows" Then
    SectionsCount = rngTarget.Rows.Count / SectionIncrement
ElseIf FillDirection = "Columns" Then
    SectionsCount = rngTarget.Columns.Count / SectionIncrement
End If

For i = 0 To SectionsCount - 1
    'set an individual section to be pasted over
   If FillDirection = "Rows" Then
        Set rngTargetSection = rngTarget((i * SectionIncrement) + 1, 1) _
            .Resize(SectionIncrement, rngTarget.Columns.Count)
    ElseIf FillDirection = "Columns" Then
        Set rngTargetSection = rngTarget(1, (i * SectionIncrement) + 1) _
            .Resize(rngTarget.Rows.Count, SectionIncrement)
    End If
    For Each objSourceCondition In rngSource.FormatConditions
        'test if it's a ColorScale - 3
       If objSourceCondition.Type = 3 Then
            SetRangeColorScale rngTargetSection, objSourceCondition
        End If
    Next objSourceCondition
Next i

exit_point:
End Sub

Obviously, when you do this you end up with a passel of conditional formatting rules, so don’t be surprised!

rule for each row

Here’s the function, called from the main routine above, that checks whether the source and target ranges are compatible:

Function CompatibleRanges(rngSource As Excel.Range, rngTarget As Excel.Range, _
    SectionIncrement As Long, FillDirection As String, _
    ByRef IncompatibleRangeError As String) As Boolean

'no #DIV/0
If SectionIncrement = 0 Then
    IncompatibleRangeError = _
    "You can't use an increment of 0"
    GoTo exit_point
End If
'can't specify a SectionIncrement bigger than the target range
If (FillDirection = "Rows" And rngTarget.Rows.Count < SectionIncrement) Or _
   (FillDirection = "Columns" And rngTarget.Columns.Count < SectionIncrement) Then
    IncompatibleRangeError = _
    "Target range must have at least" & vbCrLf & _
        SectionIncrement & " rows."
    GoTo exit_point
End If
'target range rows or columns must be
'evenly divisible by the SectionIncrement
If (FillDirection = "Rows" And rngTarget.Rows.Count Mod SectionIncrement <> 0) Or _
   (FillDirection = "Columns" And rngTarget.Columns.Count Mod SectionIncrement <> 0) Then
    IncompatibleRangeError = _
    "Target range " & FillDirection & " must be" & vbCrLf & _
         "evenly divisible by " & SectionIncrement & "."
    GoTo exit_point
End If
'target range width or height has to match
'source range width or height
If Not (rngSource.Rows.Count = rngTarget.Rows.Count Or _
        rngSource.Columns.Count = rngTarget.Columns.Count) Then
    IncompatibleRangeError = _
    "Source and Target ranges must have" & vbCrLf & _
        "either the same number" & vbCrLf & "of rows or columns."
    GoTo exit_point
End If

exit_point:
CompatibleRanges = IncompatibleRangeError = ""
End Function

I’ve run this code successfully on up to 10,000 rows. It took about 7 seconds. I did notice that deleting 9,900 of those rows afterwards takes a while, and that the workbook can then act sluggish until it’s saved. I’m not sure what the issue is.

No download right now, but I’m planning to whip up a workbook that expands this to IconSets and DataBars and whatever else I can cram in there. So look for that in a week or so.

3 thoughts on “Conditional Formatting Per-Row Color Scales

  1. Pingback: VBA FormatConditions - Per-Row ColorScales, DataBars and IconSets - yoursumbuddy

  2. Hello,

    I have been asked to apply conditional formatting to a spreadsheet, and yes, we would like the color scales to compare by row. I feel like I am cheating in asking “can I just copy that code as is, and if I can’t, can you help me a bit?” but my boss is not going to allow me to spend a couple of weeks/months learning vba to get this spreadsheet happening for him. Would you mind helping me?

    Thank you,

    Sharon

    • Sharon, you are of course free to use the code as is. As to helping, I’m afraid I won’t be able to, except to answer specific questions about this post.

      I encourage you to try to apply it and then ask specific VBA questions on Stack Overflow.

      Good luck!

Speak Your Mind

Your email address will not be published. Required fields are marked *

To post code, do this: <code> your vba here </code>