Alex
Alex

Reputation: 854

Loop through row in range and apply conditional formatting based on cell in that row, to an entire column

I've got the following table in an Excel sheet, called Teams;

TEAM TLA C COLOUR
Ferrari FER FER EE161F
Renault REN REN 00B0F0
WilliamsF1 WIL WIL 000066

The value in the C column is taken directly from the TLA column with =[@TLA]. The value in the COLOUR column is what I want the text and background colour set to when I run the macro. I also want this conditional formatting to apply to the entire column and not just that specific cell. I've got the first part working with the following sub;

Sub SetConditionalFormatting()
    Dim rng As Range
    Dim row As Range
    Dim position As Long
    Dim colourColumnIndex As Integer
    Dim tlaColumnIndex As Integer
    
    Set rng = Range("Teams")
    
    colourColumnIndex = rng.ListObject.ListColumns("COLOUR").Range.Column
    tlaColumnIndex = rng.ListObject.ListColumns("C").Range.Column
    
    For Each row In rng
        Dim colorCell As Range
        Dim tlaCell As Range
        Dim hex As String
        Dim color
        
        Set colorCell = Cells(row.row, colourColumnIndex)
        Set tlaCell = Cells(row.row, tlaColumnIndex)
        hex = colorCell.Value
        color = RGB(Application.Hex2Dec(Left(hex, 2)), Application.Hex2Dec(Mid(hex, 3, 2)), Application.Hex2Dec(Right(hex, 2)))
    
        tlaCell.FormatConditions.Delete
        
        tlaCell.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=tlaCell.Value
        tlaCell.FormatConditions(1).Interior.color = color
        tlaCell.FormatConditions(1).Font.color = color
        tlaCell.FormatConditions(1).Borders.color = RGB(19, 21, 29)
        tlaCell.FormatConditions(1).StopIfTrue = False
    Next
End Sub

However this only applies the conditional formatting to that specific cell (so $C$2 for example). What I need is the formatting to be applied to $C$2:$C$4, like it would if I'd select the entire C column and then manually copy/paste the formatting to other tables.

I've added tlaCell.FormatConditions(1).ModifyAppliesToRange Range("Teams[C]") as a final call as an attempt to make this work, but instead of applying formatting once for reach row to the entire column, it applies the formatting as seen in the first screenshot. What I need instead is for the "applies to" range to be set as in the second screenshot. Any idea how I can accomplish this?

enter image description here

enter image description here

Edit: managed to get it to work thanks to Foxfire's suggestion, this is the code I ended up with;

Sub SetConditionalFormatting()
    Dim rng As Range
    Dim row As Range
    Dim position As Long
    Dim colourColumnIndex As Integer
    Dim tlaColumnIndex As Integer
    Dim formattingColumn As Range
    Set rng = Range("Teams")
    Dim colours
    Set colours = CreateObject("Scripting.Dictionary")
    
    colourColumnIndex = rng.ListObject.ListColumns("COLOUR").Range.Column
    tlaColumnIndex = rng.ListObject.ListColumns("C").Range.Column
    
    Set formattingColumn = Range("Teams[C]")
    
    formattingColumn.FormatConditions.Delete
    
    For Each row In rng
        Dim colorCell As Range
        Dim tlaCell As Range
        
        Dim hex As String
        
        
        Set colorCell = Cells(row.row, colourColumnIndex)
        Set tlaCell = Cells(row.row, tlaColumnIndex)
        hex = colorCell.Value
        
        
        If Not colours.Exists(tlaCell.Value) Then
            colours.Add Key:=tlaCell.Value, Item:=hex
        End If
    Next
    
    Dim tla As Variant
    
    Dim index As Integer
    index = 1
    For Each tla In colours.Keys
        hex = colours(tla)
        Dim color
        color = RGB(Application.Hex2Dec(Left(hex, 2)), Application.Hex2Dec(Mid(hex, 3, 2)), Application.Hex2Dec(Right(hex, 2)))
        
        formattingColumn.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=tla
        formattingColumn.FormatConditions(index).Interior.color = color
        formattingColumn.FormatConditions(index).Font.color = color
        formattingColumn.FormatConditions(index).Borders.color = RGB(19, 21, 29)
        formattingColumn.FormatConditions(index).StopIfTrue = False
        index = index + 1
    Next
End Sub

I'll see if I can clean it up a bit, but this works how it's supposed to.

Upvotes: 2

Views: 290

Answers (1)

I made an example based on your data using a dictionary.

Sub test()
Dim i As Long
Dim LR As Long
Dim FormatRng As Range
Dim Dic As Object
Dim MyKey As Variant
Dim hex As String
Dim Mycolor As Variant


Set Dic = CreateObject("Scripting.Dictionary")

LR = Range("A" & Rows.Count).End(xlUp).Row 'last used row in column A

Set FormatRng = Range("B2:B" & LR) 'the range where I want to apply my CF rules

FormatRng.FormatConditions.Delete

For i = 2 To LR '2 is the first row where my data is
    'loop to create a Dicionary of unique items of C,COLOUR values
    If Dic.Exists(Range("C" & i).Value) = False Then Dic.Add Range("C" & i).Value, Range("D" & i).Value
Next i

'loop trough dictionary to apply cf rules to FormatRng

i = 1
For Each MyKey In Dic.Keys
    hex = Dic(MyKey)
    Mycolor = RGB(Application.Hex2Dec(Left(hex, 2)), Application.Hex2Dec(Mid(hex, 3, 2)), Application.Hex2Dec(Right(hex, 2)))
    With FormatRng
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=MyKey
        .FormatConditions(i).Interior.Color = Mycolor
        .FormatConditions(i).Font.Color = vbWhite
        .FormatConditions(i).Borders.Color = RGB(19, 21, 29)
        .FormatConditions(i).StopIfTrue = False
    End With
    i = i + 1
Next MyKey

Set Dic = Nothing
Set FormatRng = Nothing


End Sub

The output I get:

enter image description here

Excel VBA Dictionary – A Complete Guide

Upvotes: 2

Related Questions