Duplicate check with VBA code

[jgopalk]

Hi All,

I wanted to create <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help;">VBA</acronym> code for highlighting duplicate words in Sheet 2 with refer to sheet 1. Sheet 1 has master list. Sheet 2 has minimum values, which has to be compared and highlighted if any word found in sheet 1.

Example:
Sheet 1

Jasmine

Lotus

Lilly

Ladies finger

Carrot

Bird of Paradise

<tbody>
</tbody>

Sheet 2:

Jasmine

Ladies

Paradise

Blue bell

Jack fruit

<tbody>
</tbody>

After macro, answer should be:
Sheet 2:

Jasmine

Ladies

Paradise

Blue bell

Jack fruit

<tbody>
</tbody>

Note: Dupe does not need to be a exact one. For example, Master list has "Ladies finder", but in my sheet 2 i have added "Ladies" alone and it also should be highlighted.

Thanks in advance for your time in this.

Gopal​

​

 

[My Aswer Is This]

Try this:

Sub Find_Duplicates()
Application.ScreenUpdating = False
'Modified 3-28-17 1:33 AM EDT
Dim i As Long
Sheets(1).Activate
Dim Lastrow As Long
Lastrow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To Lastrow
        For b = 1 To Lastrowa
            If InStr(Cells(i, 1).Value, Sheets(2).Cells(b, 1).Value) Then
                Sheets(2).Cells(b, 1).Font.Color = vbRed
            End If
        Next
    Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

If you want the font red and Bold
Try this:

Sub Find_Duplicates()
Application.ScreenUpdating = False
'Modified 3-28-17 1:45 AM EDT
Dim i As Long
Sheets(1).Activate
Dim Lastrow As Long
Lastrow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To Lastrow
        For b = 1 To Lastrowa
            If InStr(Cells(i, 1).Value, Sheets(2).Cells(b, 1).Value) Then
                Sheets(2).Cells(b, 1).Font.Color = vbRed
                Sheets(2).Cells(b, 1).Font.Bold = True
                
            End If
        Next
    Next
Application.ScreenUpdating = True
End Sub

 

[jgopalk]

This is really great and thanks for your quick reply.

When I add "Paradise, London" in the "Sheet 2", that also should be highlighted in Red, which is not highlighting now. Duplicate need not to be a very exact one. If the "word" is in between the sentence also should be highlighted.

Hope I am clear.

Thanks,
Gopal

 

[My Aswer Is This]

That's not the way I understood your question.

In your image you showed a series on multiple words in sheet(1) and single values in sheet(2)

Someone else here at Mr. Excel will need to help you

 

[jgopalk]

Yes, I missed to mention that. Sorry for that. When I checked your query, I realized that my question could have been little more clear.

Thanks for your support.

Someone kindly check for the possibility to fix this.

Gopal

 

[jgopalk]

Thanks Dude.. I got it by modifying code. Thanks again for your help. Now the whole cell is colored for a specific word, but i need to have the specific word alone to be colored. I couldn't get that. Is there any way to get it?

Gopal

 

[My Aswer Is This]

Thanks Dude.. I got it by modifying code. Thanks again for your help. Now the whole cell is colored for a specific word, but i need to have the specific word alone to be colored. I couldn't get that. Is there any way to get it?

Gopal

Show me your script

 

[My Aswer Is This]

I'm not sure how you can do this.

If in sheet 1 you have:

This is my dog

And in sheet (2) you have:

This dog is Jane's dog

So the words "This" and "dog" and "is" are duplicates

So in sheet 2 all 3 words "dog" and "This" and "is" would need to be highlighted. And dog would have to be highlighted twice.

It will be interesting to see how this can be done.
I'm always trying to learn more myself.

 

[jgopalk]

Below is the code which I tried out. It worked. I am not familiar with code. But, I just modified your code by referring google search.

Sub Find_Duplicates()
Application.ScreenUpdating = False
'Modified 3-28-17 1:33 AM EDT
Dim i As Long
Sheets(1).Activate
Dim Lastrow As Long
Lastrow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
For b = 1 To Lastrow
If InStr(1, Sheets(2).Cells(b, 1).Value, Cells(i, 1).Value) <> 0 Then
Sheets(2).Cells(b, 1).Font.Color = vbRed
End If
Next
Next
Application.ScreenUpdating = True
End Sub


Based on your example, I will have only the important keyword in sheet 1. For example, here I will have "dog" as a keyword in Sheet 1. So I want a result like "This dog is Jane's dog". Currently I am getting "This dog is Jane's dog" (whole cell colored).

Also currently code is case sensitive. But, I want it as "Case-insensitive".

Kindly check out. I am also trying it.

Thanks,
Gopal