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-

[CODE]
[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 -


309396591 ABCENERGY SERVICES
309396591 ABCENERGY SERVICES, LTD
309396591 ABC ENERGY SERVICES INTERNATIONAL, L
309396591 ABCENERGY SERVICES, LTD
309396591 ABCENERGY SERVICES, LTD