Forum Discussion
Color cells of a worksheet by comparing entries with other worksheet.
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.
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
7 Replies
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.
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.
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
