VBA to cycle through selected rows and apply conditional formatting

[davey4444]

Hello, I have some conditional formatting to apply across numerous rows in my worksheet and I would like to speed up that process as much as possible by using VBA. Ideally I will select some cells and then the VBA would run through each row and apply the Red (High) - Green (low) cell colour formatting, dependant on the column values. My code when I recorded it is below but I don't know how to scale this if, for example, I have selected cells P18:S200 and then I want it to run through each row.

Sub Macro4()

    Range("P18:S18").Select
    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 = 8109667
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
End Sub

Thanks in advance.

 

[davey4444]

Hi, yes it should always be the same number of columns. It doesn't have to be the native conditional formatting command if that helps. As long as the highest value is red and the lowest is green with gradients of orange or yellow inbetween.

 

[Joe4]

Try the following, which should work for any range you select, regardless of size:

Sub FormatMacro()

    Dim rng1 As Range, rng2 As Range
    Dim firstRow As Long, lastRow As Long
    Dim firstCol As Long, lastCol As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Set range to current selection
    Set rng1 = Selection
    
'   Get first and last rows and columns of selected range
    firstRow = rng1.Row
    firstCol = rng1.Column
    lastRow = rng1.Rows.Count + firstRow - 1
    lastCol = rng1.Columns.Count + firstCol - 1
    
'   Loop through all rows
    For r = firstRow To lastRow
'       Build range to apply rule to
        Set rng2 = Range(Cells(r, firstCol), Cells(r, lastCol))
'       Apply conditional formatting
        rng2.FormatConditions.AddColorScale ColorScaleType:=3
        rng2.FormatConditions(rng2.FormatConditions.Count).SetFirstPriority
        rng2.FormatConditions(1).ColorScaleCriteria(1).Type = _
            xlConditionValueLowestValue
        With rng2.FormatConditions(1).ColorScaleCriteria(1).FormatColor
            .Color = 8109667
            .TintAndShade = 0
        End With
        rng2.FormatConditions(1).ColorScaleCriteria(2).Type = _
            xlConditionValuePercentile
        rng2.FormatConditions(1).ColorScaleCriteria(2).Value = 50
        With rng2.FormatConditions(1).ColorScaleCriteria(2).FormatColor
            .Color = 8711167
            .TintAndShade = 0
        End With
        rng2.FormatConditions(1).ColorScaleCriteria(3).Type = _
            xlConditionValueHighestValue
        With rng2.FormatConditions(1).ColorScaleCriteria(3).FormatColor
            .Color = 7039480
            .TintAndShade = 0
        End With
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[davey4444]

That worked a treat, thanks so much.

 

[Joe4]

You are welcome.