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:
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.
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:
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(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:
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:
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:
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!
Here’s the function, called from the main routine above, that checks whether the source and target ranges are compatible:
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.
Pingback: VBA FormatConditions - Per-Row ColorScales, DataBars and IconSets - yoursumbuddy
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!
Just found this and other examples of how to do this via VBA and it got me thinking and if figured out a relatively quick and painless way of doing the same thing without having to know or copy any script.
Apply the desired Conditional Formatting to whatever row you want and then highlight the entire row. Next Right-Click anywhere along the border (mouse should be the Move icon) and drag down to the next row. In the context menu that pops up select “Copy Here as Formats Only”. Now you should have your Conditional Format applied to both rows separately. Then continue to do this recursively except that now you can select and copy 2 or more rows at a time.
It’s not a one shot deal like the above code but it is exponentially faster than doing one line at a time. Hope this helps.
FANTASTIC! now that was clever.
Thanks, but this will apply your color scale to all the rows. I believe the goal was for each row to have its color scale based on the data just in that row. So if I change a value in the row, only the colors in that row may change. What you suggested is nice but it is not row by row.
I found that the proposed technique worked just fine!
1 – Add conditional formatting to first row (color scales, data bars, whatever)
2 – highlight the full rows of all rows that have conditional formatting on them and click “format painter” on the ribbon
3 – highlight the same number of full rows below those first ones and the conditional formatting is pasted, unique per row
Repeat steps 2 and 3 as many times as necessary. Note that the first time, you copy/paste 1 row. Then 2 rows at a time, then 4 rows at a time, and so on. VERY clever Chris S!
Excellent!
Can you do this to a pivot table?
Yes Brandon, but it’s different. I’ve got a post somewhere I think. It’s one of those projects that team out of steam.
I don’t know the VBA but thinking this is the one that I need to use the conditional formatting to color scale 3 value high, low, median repeat 3000 items. Can someone show me how to put the script in macro?
Hi Jacob, You can find lots of info on the web about how to create VBA code. If you run into specific issues you can get help in an online forum like Stack Overflow. Good luck!
You can also do this without VBA. You can add ranges with conditional formatting with formula. Put the average on the end of each row and use formulas like
=b2$colomnxfield2 ;b2(1.5*$colomnxfield2 )
for first value for example.
this was really helpful and appreciated, thank you
I’m glad to hear that!