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

Question

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?
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.

Answer 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:
Excel VBA Dictionary – A Complete
Guide