VBA find duplicates

[Jeffreyxx01]

Hi,

is there a way to find duplicates and highlighted them without using the conditional formatting?
Like I use conditional formatting for the simple find duplicates but where some of my duplicates have more words in the cell but are still duplicates with the 2 first words,

For example, I would have in column C:

Aero tech
Aero technology Ltd,

Those are duplicates for sure,
Is there a way of having a macro?

 

[mse330]

Hey Jeffrey,

Try the below VBA code (assuming you have a header in C1 & your data starts in C2)

Option Compare Text
Sub Similar_Duplicates()

Dim ws As Worksheet, lRow As Long, Txt As String
Set ws = ActiveSheet
lRow = ws.Range("C" & Rows.Count).End(xlUp).Row
ws.Range("C2:C" & lRow).Style = "Normal"

For x = 2 To lRow
    If ws.Cells(x, 3).Style = "Normal" Then
        Txt = ws.Cells(x, 3)
        For y = 2 To lRow
            If x <> y And ws.Cells(y, 3).Style = "Normal" And ws.Cells(y, 3) Like Txt & "*" Then
                ws.Cells(y, 3).Style = "Bad"
                ws.Cells(x, 3).Style = "Bad"
            End If
        Next y
    End If
Next x

End Sub

 

[Jeffreyxx01]

Hi thank you for the code,
I have data in the next column, I have free column from P to infinite
Also, I have the header in row c2 and my data start from c3

is there an easy way?

 

[Jeffreyxx01]

The code is fine at the moment, I will try it next week with more data,
Thanks again, I will let you know soon.

 

[Jeffreyxx01]

Can I have this code as a button from another worksheet to work on the DataBase worksheet? please

 

[mse330]

I have changed the code to cater for

• Data starts in row 3 & header in row 2 (you can change it yourself read my comments in the code)
• You can place a button anywhere in the workbook & link it to "Similar_Duplicates" sub

Test the code with your file (larger data set) & let me know how it goes

Option Compare Text

Sub Similar_Duplicates()

Dim ws As Worksheet, fRow As Long, lRow As Long, Txt As String
Set ws = Sheets("DataBase") '<--change the sheet name here
fRow = 3 '<--change this # to the first row you have data after the header row 
lRow = ws.Range("C" & Rows.Count).End(xlUp).Row
ws.Range("C" & fRow & ":C" & lRow).Style = "Normal"

For x = fRow To lRow
    If ws.Cells(x, 3).Style = "Normal" Then
        Txt = ws.Cells(x, 3)
        For y = fRow To lRow
            If x <> y And ws.Cells(y, 3) Like Txt & "*" Then
                ws.Cells(y, 3).Style = "Bad"
                ws.Cells(x, 3).Style = "Bad"
            End If
        Next y
    End If
Next x

End Sub

 

[Jeffreyxx01]

I have done the similar duplicates, I am not actually sure it works yet because I have done most of the check myself but I will let you know about it,
However, when I do the macro, it completely change my formatting, I want to keep my format of Arial and size 8.

 

[mse330]

I have revised the code to retain the format of the font & size

Option Compare Text

Sub Similar_Duplicates()

Dim ws As Worksheet, fRow As Long, lRow As Long, Txt As String
Set ws = Sheets("DataBase") '<--change the sheet name here
fRow = 3 '<--change this # to the first row you have data after the header row
lRow = ws.Range("C" & Rows.Count).End(xlUp).Row

With ws.Range("C" & fRow & ":C" & lRow)
    .Interior.Color = xlNone
    .Font.Color = vbBlack
End With

For x = fRow To lRow
    If ws.Cells(x, 3).Interior.Color <> RGB(255, 200, 200) Then
        Txt = ws.Cells(x, 3)
        For y = fRow To lRow
            If x <> y And ws.Cells(y, 3) Like Txt & "*" Then
                With ws.Cells(y, 3)
                    .Interior.Color = RGB(255, 200, 200)
                    .Font.Color = RGB(155, 0, 0)
                End With
                With ws.Cells(x, 3)
                    .Interior.Color = RGB(255, 200, 200)
                    .Font.Color = RGB(155, 0, 0)
                End With
            End If
        Next y
    End If
Next x

End Sub

 

[Jeffreyxx01]

Thanks for the update on the code, I will let you know on Saturday how it works

 

[Jeffreyxx01]

Hi mse330,

I have tested the macro, it seems not working very well,

For example, I have a name: Xiros Limited and the other one is Xiros Ltd, this is the same name but with abbreviation and it did not colour it,
Can you help me out please?