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

[aayaanmayank]

---

Hi, Can any one help me in this, i have a column contains ID and another column contains company names.

i have to 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 data-

AE36630GU	PHARMACEUTICAL INDUSTRIES <tbody> </tbody>
AE36630GU	PHARMACEUTICAL INDUSTRIES <tbody> </tbody>
ALJ61924662T <tbody> </tbody>	ABC INVEST <tbody> </tbody>
ALJ61924662T <tbody> </tbody>	ABC INVEST SH.P.K (L.T.D.) <tbody> </tbody> <tbody> </tbody>
ALJ61924662T <tbody> </tbody>	ABC INVEST SHPK <tbody> </tbody>
ALK43128401L <tbody> </tbody>	INVEST PETROLEUM ALBANIA LTD <tbody> </tbody>
ALK43128401L <tbody> </tbody>	INVEST PETROLEUM ALBANIA LTD <tbody> </tbody>
ALK82418662C <tbody> </tbody>	RAH HYDROPOWER <tbody> </tbody>
ALK82418662C <tbody> </tbody>	RAH HYDROPOWER SH.A. <tbody> </tbody>
ALK82418662C <tbody> </tbody>	RAH Hydropower Sh.A. <tbody> </tbody>

<tbody>
</tbody>

<tbody>
</tbody>

so far i have prepared a macro which is moving row by row but that only matches company names with previous row

Set SHGROUP = ThisWorkbook.Worksheets("Data_DQ")


Range("F2").Select
ActiveCell.Interior.Color = vbYellow


For U = 2 To LastRow1


Set MYNAME2 = Cells(U, "f")
Set MYNAME3 = Cells((U + 1), ("f"))


If MYNAME2.Value = MYNAME3 Then


SHGROUP.Cells(U, "f").Interior.Color = vbGreen
SHGROUP.Cells(U + 1, "f").Interior.Color = vbGreen
Else


SHGROUP.Cells(U + 1, "f").Interior.Color = vbYellow


End If
Next U

 

[aayaanmayank]

How about

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

[/i have tried this code it is not working properly Below is my data. it is throwing "Yellow Color" in 1st and 2nd row, rest are Green ]

409396591	ABCENERGYSERVICES
409396591	ABCENERGYSERVICESLIMITEDLIABILITYCOMPANY
409396591	ABCENERGYSERVICESINTERNATIONALL
409396591	ABCENERGYSERVICESLIMITEDLIABILITYCOMPANY
409396591	ABCENERGYSERVICESLIMITEDLIABILITYCOMPANY

<colgroup><col><col></colgroup><tbody>
</tbody>

 

[aayaanmayank]

How about

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

[/i have tried this code it is not working properly Below is my data. it is throwing "Yellow Color" in 1st and 2nd row, rest are Green ]

409396591	ABCENERGYSERVICES
409396591	ABCENERGYSERVICESLIMITEDLIABILITYCOMPANY
409396591	ABCENERGYSERVICESINTERNATIONALL
409396591	ABCENERGYSERVICESLIMITEDLIABILITYCOMPANY
409396591	ABCENERGYSERVICESLIMITEDLIABILITYCOMPANY

<tbody>
</tbody>

[However it should through Yellow color in all the cells as first value is not match with rest]