Need to Match two or more rows values based on their ID in another cell

[aayaanmayank]

Hi Can any one help me on below code:- first check that how many cells or times one/same id contains and then match and color code (if matches then green else yellow) company name with the similar times.Below is the code given in this forum but it not working properly-

[Sub HiliteCells()   Dim cl As Range
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = vbTextCompare
   For Each cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      If Not Dic.exists(cl.Value) Then
         Dic.Add cl.Value, CreateObject("scripting.dictionary")
         Dic(cl.Value).Add cl.Offset(, 1).Value, cl.Offset(, 1)
         cl.Offset(, 1).Interior.Color = vbYellow
      ElseIf Not Dic(cl.Value).exists(cl.Offset(, 1).Value) Then
         Dic(cl.Value).Add cl.Offset(, 1).Value, cl.Offset(, 1)
         cl.Offset(, 1).Interior.Color = vbYellow
      Else
         cl.Offset(, 1).Interior.Color = vbGreen
         Dic(cl.Value)(cl.Offset(, 1).Value).Interior.Color = vbGreen
      End If
   Next cl
End Sub] 

below is the example of my data  -

[TABLE="width: 134"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]309396591[/TD]
[TD]ABCENERGY SERVICES[/TD]
[/TR]
[TR]
[TD]309396591[/TD]
[TD]ABCENERGY SERVICES, LTD[/TD]
[/TR]
[TR]
[TD]309396591[/TD]
[TD]ABC ENERGY SERVICES INTERNATIONAL, L[/TD]
[/TR]
[TR]
[TD]309396591[/TD]
[TD]ABCENERGY SERVICES, LTD[/TD]
[/TR]
[TR]
[TD]309396591[/TD]
[TD]ABCENERGY SERVICES, LTD[/TD]
[/TR]
</tbody>[/TABLE]

 

[aayaanmayank]

Below is the code -

[COLOR=#333333][Sub HiliteCells() Dim cl As Range[/COLOR]
[COLOR=#333333]Dim Dic As Object[/COLOR]

[COLOR=#333333]Set Dic = CreateObject("scripting.dictionary")[/COLOR]
[COLOR=#333333]Dic.comparemode = vbTextCompare[/COLOR]
[COLOR=#333333]For Each cl In Range("A2", Range("A" & Rows.Count).End(xlUp))[/COLOR]
[COLOR=#333333]If Not Dic.exists(cl.Value) Then[/COLOR]
[COLOR=#333333]Dic.Add cl.Value, CreateObject("scripting.dictionary")[/COLOR]
[COLOR=#333333]Dic(cl.Value).Add cl.Offset(, 1).Value, cl.Offset(, 1)[/COLOR]
[COLOR=#333333]cl.Offset(, 1).Interior.Color = vbYellow[/COLOR]
[COLOR=#333333]ElseIf Not Dic(cl.Value).exists(cl.Offset(, 1).Value) Then[/COLOR]
[COLOR=#333333]Dic(cl.Value).Add cl.Offset(, 1).Value, cl.Offset(, 1)[/COLOR]
[COLOR=#333333]cl.Offset(, 1).Interior.Color = vbYellow[/COLOR]
[COLOR=#333333]Else[/COLOR]
[COLOR=#333333]cl.Offset(, 1).Interior.Color = vbGreen[/COLOR]
[COLOR=#333333]Dic(cl.Value)(cl.Offset(, 1).Value).Interior.Color = vbGreen[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]Next cl[/COLOR]
[COLOR=#333333]End Sub] [/COLOR]