SOLVED

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

Copper Contributor

In the attached workbook, i have to compare the *COMPETITOR* Worksheet with the *PLAN* Worksheet. The comparison is to be done between Plans Premium, Plan_Amount and Item 1 Price in both the sheets and conditionally format the Competitor worksheets entry as blue and red depending on the values( if lower or higher than the values in Plan worksheet).

 

I have to automate this step along multiple sheet(for different states). Kindly help me out here. Apologies for lack of clarity,
i will try to frame the question in a better way if it's not clear.

 

 

7 Replies

@vicasso 

If you need to compare the values for the said plans on both the worksheets based on their Plan ID, there is no common Plan ID in both the sheets.

 

To make it more clear, you should mock up the desired output manually based on the sample data, add comments in there to explain the logic behind the desired output and upload the sample workbook again so that we can visualize what you are trying to achieve.

 

Also, what do you mean when you say "I have to automate this step along multiple sheet(for different states)"?

It would be better if you include that scenario as well in the sample workbook so that it is clear what would be the layout in case of multiple states.

Hi @Subodh_Tiwari_sktneer 

 

I have to compare the plans on the *COMPETITOR* worksheet with the Plans of *PLAN* Worksheet. Comparison is to be done between Plan ID in Row 1 and Plan ID for comparison in Row 3. 

Row 3 values can be found in *PLAN* Worksheet. I have added one more worksheet *FINAL RESULT* to show how the output is supposed to look. 

 

I have to write a VBA code that i can use in multiple sheets since i have to replicate the same process for different worksheets. 

best response confirmed by vicasso (Copper Contributor)
Solution

@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

 

Hi @Subodh_Tiwari_sktneer 

 

can you help me understand the working functionality of this code?

 

Thanks

 

@vicasso 

Please let me know which part do you find difficult to understand.

To fully understand the code you must have an idea about Arrays and Dictionary. If you are not comfortable with them, please read about them first. There are plenty of study material available online even videos. You may search on YouTube for Excel VBA arrays tutorial and Dictionary tutorial.

Let me know if you don't find one.

@Subodh_Tiwari_sktneer 

Can you explain to me this part of code.
------------------------------------------------------------------------------------------
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
----------------------------------------------------------------------------------------
Thanks

@vicasso 

x = wsPlan.Range("A1").CurrentRegion.Value

The Current Region of A1 is the range A1:E5. If you manually select the cell A1 on Plan Sheet and hit Ctrl+* it will select the range A1:E5 and this is the current region for cell A1 i.e. all the adjacent rows and columns with data with no blank row or column in between.

The line reads all the value of the current region into the array x.

So now the array x will contain all the data in the range A1:E5.

Array x has two dimensions, one dimension is for rows and another for columns.

 

Set Plan = CreateObject("Scripting.Dictionary")

Here a dictionary called Plan is being created to store the actual data from the actual data range B3:E5 for specific criteria Plan ID, State and the column header.

e.g. B3 has a value 400 which is specific for Plan ID Plan Premium, State CA and column header 1300.

 

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

In the above lines, we are looping through the array x and populating the dictionary Plan with the combination of Plan ID, State and Column Header as a Key and the actual value as Item in the following line...

Plan.Item(x(1, j) & x(2, j) & x(i, 1)) = x(i, j)

 

e.g. in the above line i stands for Rows and j stands for Columns and we start the row loop with i=3 and column loop with j=2 i.e. Row3 and column 2 which should be cell B3 on the Plan Sheet.

So take the example of B3, if we translate the above line of code into values, it is like this...

Plan.Item(1300 & CA & Plan Premium) = 400

 

So the dictionary Plan will have a unique key "1300CAPlan Premium" with a value 400 assigned to it.

And later we can loop through the data on the Competitor Sheet and check if a same combination is found there and if yes, we can compare the stored value in the dictionary for that key with the value on the Competitor Sheet and highlight the cells accordingly.

 

Hope I was able to explain it.

1 best response

Accepted Solutions
best response confirmed by vicasso (Copper Contributor)
Solution

@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

 

View solution in original post