How to use VBA to do Conditional Formatting (NOT applying VBA)

[EmmaG]

I have two sheets.

Sheet 1 looks like this:

Sheet 2's layout is exactly like sheet1's, but rows' sequence may change and some $ amounts may change as well

Currently, I am using this VBA code to compare and contrast two sheets, then highlight the differences.

Sub Try()

Range("F2:F10").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(SUMIFS('Sheet1'!F:F, 'Sheet1'!A:A, A2, 'Sheet1'!D:D, D2)<>F2, A2<>"""")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

End Sub

If I run the code above, it will find rows from both sheets with same PO/SO, same Activity, but different Amount, then highlight the Amount cells

However, this code is simply “applying” conditional formatting to the sheet. In other words, if I go to Conditional Formatting, and click “Manage Rules”, I will see the formula below in the Rule Manager box:

=AND(SUMIFS(Sheet1!F:F, Sheet1!A:A, A2, Sheet1!D:D, D2)<>F2, A2<>"")

What I really want is to use the code to “do” conditional formatting, not “apply” conditional formatting. I don’t want any rules exist in the Conditional Formatting Rules Manager box after I run the VBA.

I am fairly new to VBA, this is what I have for now:

Sub Test ()

Dim PrevPOSO As String

Dim PrevAct As String

Dim PrevAmount As String


For i = 2 To ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count

PrevPOSO = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value

PrevAct = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value

PrevAmount = ThisWorkbook.Worksheets("Sheet1").Cells(i, 6).Value



For s = 2 To ThisWorkbook.Worksheets("Sheet2").UsedRange.Rows.Count

If ThisWorkbook.Worksheets("Sheet2").Cells(s, 1).Value <> "" And ThisWorkbook.Worksheets("Sheet2").Cells(s, 1).Value = PrevPOSO And ThisWorkbook.Worksheets("Sheet2").Cells(s, 4).Value = PrevAct And ThisWorkbook.Worksheets("PCAM Commitments").Cells(s, 6).Value <> PrevAmount Then

ThisWorkbook.Worksheets("PCAM Commitments").Cells(s, 6).Interior.Color = 192

End If


Next s

Next i


End Sub

But if I try to run this code, nothing will happen...No error warning, no any reaction whatsoever. So any comments would be appreciated!

 

[Fluff]

Hi & welcome to MrExcel.
Will the PO/SO number only appear once on each sheet?

 

[EmmaG]

Hi & welcome to MrExcel.
Will the PO/SO number only appear once on each sheet?

Hey Fluff!
No, PO/SO itself cannot serve as an unique identifier. PO/SO along with Activity is the unique identifier for each row in this case

 

[Fluff]

Ok, how about

Sub EmmaG()
   Dim Cl As Range
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic.Item(Cl.Value & "|" & Cl.Offset(, 3).Value) = Cl.Offset(, 5).Value
      Next Cl
   End With
   With Sheets("Sheet2")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Cl.Value <> "" Then
            If Dic.Item(Cl.Value & "|" & Cl.Offset(, 3).Value) <> Cl.Offset(, 5).Value Then
               Cl.Offset(, 5).Interior.Color = 192
            End If
         End If
      Next Cl
   End With
End Sub

 

[EmmaG]

Ok, how about

Sub EmmaG()
   Dim Cl As Range
   Dim Dic As Object
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic.Item(Cl.Value & "|" & Cl.Offset(, 3).Value) = Cl.Offset(, 5).Value
      Next Cl
   End With
   With Sheets("Sheet2")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Cl.Value <> "" Then
            If Dic.Item(Cl.Value & "|" & Cl.Offset(, 3).Value) <> Cl.Offset(, 5).Value Then
               Cl.Offset(, 5).Interior.Color = 192
            End If
         End If
      Next Cl
   End With
End Sub

You are a life saver! It worked. Thank you!! I am not very familiar with the offset/create object functions in VBA, so I will do some research on your code

 

[Fluff]

You're welcome & thanks for the feedback