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

 

[Learn Excel in Tamil]

Hi

Please try with below macro

Sub ColourMatch()

Dim SHGROUP  As Worksheet
Dim Temp As String
Dim I As String
Dim Lrow As String
Set SHGROUP = ThisWorkbook.Worksheets("Sheet2")
Range("A1").Select 'Change Cell value
I = "A$1:" 'mention first cellvalue range

Do While ActiveCell.Value <> ""

Temp = WorksheetFunction.CountIf(Range(I & ActiveCell.Address), Range(ActiveCell.Address))

If Temp > 1 Then

ActiveCell.Interior.Color = vbGreen

Else

ActiveCell.Interior.Color = vbYellow

End If

ActiveCell.Offset(1, 0).Select
Loop

End Sub

 

[aayaanmayank]

Thanks but it is not working. it is just doing color coding yellow & then green color on IDs. what i need first it has to check that how many times that id exists then based on id count it has to match name rows with similar nunber of times.
e.g. US127473334L id exits 3 times in columns A so then it sud go to column B and match 1st row company name with next two rows/ hope it makes sense.

 

[Learn Excel in Tamil]

Hi,

Let's take example ID "ALJ61924662T", has 3 time and company name are different, Please advise if company name match what should do and if now what should do ?

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>

<tbody>
</tbody>

 

[aayaanmayank]

if match then green color else yellow color

 

[Fluff]

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

 

[aayaanmayank]

Hi Could you please advise that why is it not matching below ones. it is doing yellow color in all the cells however last 3 cells has same names

ALK82418002C	DEVOLL HYDROPOWER
ALK82418002C	DEVOLL HYDROPOWER SH.A.
ALK82418002C	Devoll Hydropower Sh.A.
ALK82418002C	DEVOLL HYDROPOWER SHA

<tbody>
</tbody>

 

[Fluff]

They are yellow because not all names for that ID match.

 

[aayaanmayank]

Thanks for clarity.. can you advise is there any possibility if i have to add that if 80% string matches then it sud give green color.

 

[Fluff]

To do that properly would require Fuzzy Logic, which is beyond my abilities.
However this will consider a match if the 1st 15 characters are the same.

Sub HiliteCells()
   Dim Cl As Range
   Dim Dic As Object
   Dim V2 As String
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = vbTextCompare
   For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
      V2 = Left(Cl.Offset(, 1).Value, [COLOR=#ff0000]15[/COLOR])
      If Not Dic.exists(Cl.Value) Then
         Dic.Add Cl.Value, CreateObject("scripting.dictionary")
         Dic(Cl.Value).comparemode = vbTextCompare
         Dic(Cl.Value).Add V2, Cl.Offset(, 1)
         Debug.Print Dic(Cl.Value)(Left(Cl.Offset(, 1).Value, Len(Cl.Offset(, 1).Value) - 0.2 * Len(Cl.Offset(, 1).Value)))
         Cl.Offset(, 1).Interior.Color = vbYellow
      ElseIf Not Dic(Cl.Value).exists(V2) Then
         Dic(Cl.Value).Add V2, Cl.Offset(, 1)
         Cl.Offset(, 1).Interior.Color = vbYellow
      Else
         Cl.Offset(, 1).Interior.Color = vbGreen
         Dic(Cl.Value)(V2).Interior.Color = vbGreen
      End If
   Next Cl
End Sub

Change the value in red for how many characters you want to consider