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-
Below is my data, in this example ID "309396591" are 5 times so first it sud calculate that how many time that id exits then it sud move to the next columns and match first company name with the rest 4 cells

309396591 ABCENERGY SERVICES
309396591 ABCENERGY SERVICES, LTD
309396591 ABC ENERGY SERVICES INTERNATIONAL, L
309396591 ABCENERGY SERVICES, LTD
309396591 ABCENERGY SERVICES, LTD
90786534 MANUKO PPT
90786534 MANUKO PPT

 

[AliGW]

I see no code - just a list of data.

 

[aayaanmayank]

I see no code - just a list of data.

Sorry here is the 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