Automatically color-code cells in one sheet based on values matched from another sheet

[JMB99]

I have a situation with color-shading certain cells in Excel which I hope someone in the Forum can help me with.

I have three sheets in an excel file (attached).

Sheet 1 ("Main Stats") contains the summary statistics of the number of insurance payments broken down by group, payment type (DC or DB) and agreement type. Note in the example, there are just 3 groups but in reality there are hundreds, as each group represents a different geographic area.

Sheets 2 & 3 (called "Defined Contribution - DC" and "Defined Benefit - DB" respectively) contain the agreement types themselves, associated with each payment type.

Note, that "DC" payments are colored in yellow in the Main Stats sheet, and "DB" payments are in green -- both which I've done manually for this example.

My goal: I want to be able to display the agreement stats associated with each payment type using the color found in the DC or DB sheets, but automatically instead of manually.

Is there a way using VBA on "Main Stats" to programmatically look at the agreement type in cols B through G from Row 6 on down,
and, after matching it with appropriate Payment type sheet (DC or DB), apply the correct color to these cells?

Any help, hints or advice would be much appreciated.

Jeff

[TMS]

Why do you need VBA? You could us Conditional Formatting with a simple COUNTIF formula.

[JohnTopley]

Option Explicit
Sub demo()
Dim ws(1 To 3) As Worksheet
Dim DC_Rng As Range, DB_Rng As Range
Dim lr As Long, c As Long, r As Long, clr As Long
Dim dc_sum As Long, db_Sum As Long
Dim res As Variant

Application.ScreenUpdating = False

Set ws(1) = Sheets("Main Stats")
Set ws(2) = Sheets("Defined Contribution DC")
Set ws(3) = Sheets("Defined Benefit DB")

With ws(2)
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    Set DC_Rng = .Range("A3:A" & lr)
End With
With ws(3)
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    Set DB_Rng = .Range("A3:A" & lr)
End With

With ws(1)

    For c = 2 To 6 Step 2
        dc_sum = 0: db_Sum = 0
        lr = .Cells(Rows.Count, c).End(xlUp).Row
        For r = 6 To lr
            If IsEmpty(.Cells(r, c)) Then Exit For
            res = Application.Match(.Cells(r, c), DC_Rng, 0)
            If IsNumeric(res) Then
               clr = ws(2).Cells(res, 1).Interior.Color
               .Cells(r, c).Resize(, 2).Interior.Color = clr
               dc_sum = dc_sum + .Cells(r, c + 1)
            Else
                res = Application.Match(.Cells(r, c), DB_Rng, 0)
                If IsNumeric(res) Then
                    clr = ws(3).Cells(res, 1).Interior.Color
                    .Cells(r, c).Resize(, 2).Interior.Color = clr
                    db_Sum = db_Sum + .Cells(r, c + 1)
                Else
                    MsgBox "Agreement Type " & .Cells(r, c) & " Not found"
                End If
            End If
        Next r
        .Cells(4, c) = dc_sum: .Cells(4, c + 1) = db_Sum
    Next c

End With

Application.ScreenUpdating = True

End Sub

Also calculates totals in row 4

Any reason for not putting DC/DB in the same sheet (adding another column with DC or DB if required) ? This will enable a simple Conditional Formatting solution as per reply from TMS in post #2

[TMS]

@JT: still two conditions

[JMB99]

Thank you TMS and JohnTopley for your helpful replies. I will try to use Conditional Formatting with a COUNTIF, as it would be easier to maintain. If I don't acheive that, then I will revert to JohnTopley's VBA solution he so kindly provided. Much appreciated help!
Jeff

[TMS]

You're welcome. Thanks for the rep.

[JohnTopley]

Thanks from me too for the rep.