Color cells of a worksheet by comparing entries with other worksheet.

vicasso 

Please find the attached with the code on Module1 and a button called "Compare Plans" on Competitor Sheet. You may click this button to run the code.

When the code executes, it will prompt you to select any cell on the Competitor Sheet. To do so, if the Competitor Sheet is not currently the active sheet, activate the Competitor Sheet and select any random cell on the Competitor Sheet to set the Competitor Sheet.

Same way you will get a prompt to select any cell on the Plan Sheet and you can activate the Plan Sheet in the workbook and select any random cell on the Plan Sheet to set the Plan Sheet.

Once you define the Competitor Sheet and the Plan Sheet, the code will compare the Plans as per your requirement and apply the relevant background color to the cells on the Competitor Sheet.

I have made this setup so that you can run this code for any State Sheet and choose whatever Competitor Sheet you wish to compare irrespective of it's name with the whatever is the Plan Sheet.

The Code on Module1:

Sub PlanIDComparison()
Dim wsCompetitor        As Worksheet
Dim wsPlan              As Worksheet
Dim x                   As Variant
Dim Plan                As Object
Dim i                   As Long
Dim j                   As Long

On Error Resume Next
Set wsCompetitor = Application.InputBox("Please activate the Competitor Sheet you want to compare." & vbNewLine & _
                                "And select any cell on that Sheet to set the Competitor Sheet.", "Select Competitor Sheet!", Type:=8).Parent

If wsCompetitor Is Nothing Then
    MsgBox "You didn't select the Competitor Sheet.", vbExclamation
    Exit Sub
End If

On Error Resume Next
Set wsPlan = Application.InputBox("Please activate the Plan Sheet you want to compare the Competitor Sheet with." & vbNewLine & _
                                "And select any cell on that Sheet to set the Plan Sheet.", "Select Plan Sheet!", Type:=8).Parent

If wsPlan Is Nothing Then
    MsgBox "You didn't select the Plan Sheet.", vbExclamation
    Exit Sub
End If

x = wsPlan.Range("A1").CurrentRegion.Value
Set Plan = CreateObject("Scripting.Dictionary")

For i = 3 To UBound(x, 1)
    For j = 2 To UBound(x, 2)
        Plan.Item(x(1, j) & x(2, j) & x(i, 1)) = x(i, j)
    Next j
Next i

x = wsCompetitor.Range("A1").CurrentRegion.Value
wsCompetitor.Range("A1").CurrentRegion.Offset(, 1).Interior.ColorIndex = xlNone

For i = 4 To UBound(x, 1)
    For j = 1 To UBound(x, 2)
        If Plan.exists(x(3, j) & x(2, j) & x(i, 1)) Then
            If x(i, j) > Plan(x(3, j) & x(2, j) & x(i, 1)) Then
                wsCompetitor.Cells(i, j).Interior.Color = vbRed
            ElseIf x(i, j) <= Plan(x(3, j) & x(2, j) & x(i, 1)) Then
                wsCompetitor.Cells(i, j).Interior.Color = RGB(0, 176, 80)
            End If
        End If
    Next j
Next i
End Sub