Excel VBA color cell based on value in two other cells

Question

I am trying to fill cells in a range with color based on the values of two other cells.

I work with the table below:

I want to color cells where Type = "B" and Helper1 = 1 or where Type = "C" and Helper 2 = 1.

Desired result:

I was able to achieve this using conditional formatting, however because I cannot copy the cond formatting to other workbooks (due to missing helper rows), I need to do it in VBA.

Can anyone point me into the right direction here?

Thanks a lot!

Answer 1

Just loop trough each cell and check if first column equals B or C and if row 1 or 2 of data equals to 1

Application.ScreenUpdating = False
Dim rng As Range

For Each rng In Range("A1").CurrentRegion
    If rng.Column = 1 Or rng.Row = 1 Or rng.Row = 2 Then
        'do nothing, headers and first column
    Else
        If Cells(rng.Row, 1) = "B" And Cells(1, rng.Column) = 1 Then rng.Interior.Color = vbYellow 'if first column=B and Helper1=1
        If Cells(rng.Row, 1) = "C" And Cells(2, rng.Column) = 1 Then rng.Interior.Color = vbYellow 'if first column=B and Helper2=1
    End If
Next rng
Application.ScreenUpdating = True

Notice Column H got no yellow color because Helper1 and Helper2 are both zeros (I did that for testing purposes)

Answer 2

Even if you received an answer, please test the next way, too. It should be a little faster:

Sub colorRangesConditionally()
   Dim sh As Worksheet, lastR As Long, arr, rngH1 As Range, rngH2 As Range, i As Long
   
   Set sh = ActiveSheet
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).Row
   
   arr = sh.Range("A1:M" & lastR).Value2 'place the range in an array for faster iteration
   sh.Range("A3:M" & lastR).ClearFormats 'clear format of the previous runs
   
   For i = 2 To 13
        If arr(1, i) = 1 Then addToRange rngH1, sh.cells(1, i)
        If arr(2, i) = 1 Then addToRange rngH2, sh.cells(2, i)
   Next i
   Set rngH1 = rngH1.EntireColumn
   Set rngH2 = rngH2.EntireColumn
   
   Application.ScreenUpdating = False
   For i = 3 To UBound(arr)
        If arr(i, 1) = "B" And Not Intersect(rows(i), rngH1) Is Nothing Then
            Intersect(rows(i), rngH1).Interior.Color = vbYellow
        End If
        If arr(i, 1) = "C" And Not Intersect(rows(i), rngH2) Is Nothing Then
            Intersect(rows(i), rngH2).Interior.Color = vbYellow
        End If
   Next i
   Application.ScreenUpdating = True
End Sub

Sub addToRange(rngU As Range, rng As Range)
    If rngU Is Nothing Then
        Set rngU = rng
    Else
        Set rngU = Union(rngU, rng)
    End If
End Sub