Dynamic Conditional Formatting (Index, Match)

Question

Found this code and it does "part" of what i require. I have multiple conditions (20) and wish to set font, background, pattern color based on lookup.

i need: On sheet2 range A:A if value matches column J:J on color sheet then corresponding fill/pattern color/font color are applied.

I have: Fill color in "G" of Colors sheet. Pattern color in "H" of colors sheet. Font Color in "I" of Colors sheet. Color codes in "J" of Colors sheet.example

Would someone be so kind and modify it for me to also change pattern color, font color the same way it changes background?

Tried for couple of hours and sadly failed. I reckon it is something to do with setting ranges and interior.pattern / colorindex etc.

Unless you have an easier way than this? Hope i made sense. Fried a bit, my apologies.

The code:

Sub SetColors()

    ' DataCells: The cells that's going to be checked against the color values
    Set DataCells = Range("A1:A15") ' Update this value according to your data cell range

    ' ColorValueCells: The cells that contain the values to be colored
    Set ColorValueCells = Sheets("Colors").Range("j2:j41") ' Update this value according to your color value + index range

    ' Loop through data cells
    For Each DataCell In DataCells

        ' Loop through color value cells
        For Each ColorValueCell In ColorValueCells

            ' Search for a match
            If DataCell.Value = ColorValueCell.Value Then

                ' If there is a match, find the color index
                Set ColorIndexCell = Sheets("Colors").Range("g" & ColorValueCell.Row)


                ' Set data cell's background color with the color index
                DataCell.Interior.ColorIndex = ColorIndexCell.Value


            End If
        Next
    Next
End Sub

Answer 1

You can use Find() instead of a nested loop:

Sub SetColors()
    Dim DataCells As Range, ColorValueCells As Range
    Dim datacell As Range, f As Range

    Set DataCells = Range("A1:A15")
    Set ColorValueCells = Sheets("Colors").Range("J2:J41")

    For Each datacell In DataCells

        Set f = ColorValueCells.Find(datacell.Value, lookat:=xlWhole) '<< match the color
        If Not f Is Nothing Then
            'got a match: set the properties from this row
            With datacell
                .Interior.ColorIndex = Sheets("Colors").Cells(f.Row, "G").Value
                'etc for any other settings...
            End With
        End If
    Next
End Sub

EDIT: Instead of storing the various formatting settings in cells on the same row as the f cell, you might consider formatting each of those cells as you want, then copying the settings directly from f to each of the target cells.

E.g.

With datacell
    .Interior.ColorIndex = f.Interior.ColorIndex
    'etc for any other settings...
End With

Answer 2

Fill, Pattern & Font

• Sheet2 is the CodeName of the sheet. You can rename it on the Tab.

• The column variables are declared as variant to be able to use either column numbers or column letters.

  Option Explicit
  
  Sub FillColors()
  
    Const cStrRange As String = "A1:A15"  ' Target Range Address
    Const cStrColor As String = "J2:J41"  ' ColorIndex Range Address
    Const cVntFill As Variant = "G"       ' Fill ColorIndex Column
    Const cVntPattern As Variant = "H"    ' Pattern ColorIndex Column
    Const cVntFont As Variant = "I"       ' Font ColorIndex Column
  
    Dim Datacells As Range                ' Target Range
    Dim ColorValueCells As Range          ' ColorIndex Range
    Dim DataCell As Range                 ' Target Range Current Cell
    Dim ColorValueCell As Range           ' ColorIndex Range Current Cell
    Dim ColorIndexCell As Range           ' ColorIndex Match Cell
  
    With Sheet2
      Set Datacells = .Range(cStrRange)
      Set ColorValueCells = .Range(cStrColor)
      For Each DataCell In Datacells
        For Each ColorValueCell In ColorValueCells
          If DataCell.Value = ColorValueCell.Value Then
            Set ColorIndexCell = .Cells(ColorValueCell.Row, cVntFill)
            DataCell.Interior.ColorIndex = ColorIndexCell.Value
            Set ColorIndexCell = .Cells(ColorValueCell.Row, cVntPattern)
            DataCell.Interior.PatternColorIndex = ColorIndexCell.Value
            Set ColorIndexCell = .Cells(ColorValueCell.Row, cVntFont)
            DataCell.Font.ColorIndex = ColorIndexCell.Value
          End If
        Next
      Next
    End With
  
    Set ColorIndexCell = Nothing
    Set ColorValueCell = Nothing
    Set DataCell = Nothing
    Set ColorValueCells = Nothing
    Set Datacells = Nothing
  
  End Sub