Excel 2010 conditional formatting individual rows - excel

Question

I am trying to use conditional formatting (green - yellow - red color scales) on 844 distinct rows to track premium volume over the last six years (years are columns). Here is the tricky part in between each volume column is number of items. I would like to format each row for premium volume and leave the number of items unchanged.
At this point I am selecting each individual premium volume cell by holding ctrl down and then selecting the conditional formatting.
I am trying to automate this so I don't have to continue this process for 844 rows and future spreadsheets as well.
I attached a picture of the worksheet for your reference.
Any help is greatly appreciated!!!
Thanks,
Brad

Answer 1

I got some basic code for the conditional formatting by running the Macro Recorder. I replaced all the occurrences of Selection with a rng variable, and set that rng variable as a parameter to the subroutine so the Sub can be called in a loop:
Sub SetRangeCF(rng As Excel.Range)
rng.FormatConditions.AddColorScale ColorScaleType:=3
rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority
rng.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With rng.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
rng.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
rng.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With rng.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 8711167
.TintAndShade = 0
End With
rng.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With rng.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
End Sub
Then you call the sub above in a loop, in this case once for any row that has a value in column A. This assumes that the condtional formatting starts in row 2 and that you have uninterrupted data in column A. If not, you'd have to adjust this looping code:
Sub SetEachRow()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim cell As Excel.Range
Set ws = ActiveSheet 'change as necessary
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For Each cell In .Range("A1:A" & LastRow)http://stackoverflow.com/questions/10245638/excel-changes-conditional-formatting-formula?rq=1
cell.EntireRow.FormatConditions.Delete
SetRangeCF cell.EntireRow
Next cell
End With
End Sub
I don't know what the limit of rows is that this will work on, but 1,000 worked fine for me.