VBA to Search, Identify and Highlight Duplicates

[wom2007]

Thanks to all who responded to my last question. Here is a challenge.

I have some account data I pull at work:

I am trying to create a VBA code that does the following in a workbook:

Look in Sheet1, column A, each row,
Then look in Sheet2, column A, each row,
And search to see if any of the “words” in the text in Sheet1, column A, each row matches any of the “words” in the text in Sheet2, column A, each row

If there is a match then highlight the cells in Sheet1, column A, each row, in yellow that matches those in Sheet2, column A, each row

Loop.


The trick with this VBA code is that I am NOT searching for exact matches, I am searching for like words within a string of text made up of more than one words and possible characters.


An example of this maybe an account with the name MICHAELS/CVS in Sheet1, column A, and in Sheet2, column A, the account name is DNR/MICHAELS STORES INC/STRATGC PRT

I need a VBA code smart enough to identify that Michaels is on the other sheet and is thus a duplicate. I would be great if this code can identify the duplicate without me specifying to look for Michaels.

I need this for a model I am building at work. I am still new to VBA, so please make this a simple for me as possible. Your help is much appreciated.

 

[SkipVought]

"...identify the duplicate without me specifying to look for Michaels..."

How is that going to work? Look for something embedded in a string that might be embedded in another string?

Check out the LIKE operator.

Check out the SPLIT function in order to split ALL the "words" into a unique list.

Clean out the unique list to remove common words.

Use the unique list with the LIKE operator to find multiple occurrances.

Skip,

_[red][/red]

 

[wom2007]

Skip, thank you for your suggestion. Are you sure their is no other way to do this?

What if i can create a list of 30 specific words that i would like excel to search on and if a match is found then that match is highlighted in sheet2.

How can i write this code: Below is my first attempt, but this is just a find and notify me code. I need to modify the code below to reference a lookup table with the 30 specific words and then go to sheet2 and highlight in yellow any cell in which the text string has the looked up text.



Public Sub FindText()
'Run from standard module, like: Module1.

Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer

myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With
Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If

End Sub

 

[SkipVought]

Instead if entering words to search for, use a loop. Inside this loop you loop thru each worksheet as you do. When you find a match, write the word, sheet and reference to another list. Then you can analyze THIS list for dulplcates.

Skip,

_[red][/red]

 

[wom2007]

Can you help me out with the code, I am still quite new to VBA and my head is spinning right now from surfing the forums all day. Please help!!!!!

 

[SkipVought]

On a separate sheet named List, enter your list in A1 and following.

dim r as range, lRowOut as long
lRowOut = 2
with sheets("List")
  .cells(lRowOut, "C").value = LookupValue
  .cells(lRowOut, "D").value = Sheet
  .cells(lRowOut, "E").value = Addr
end with
for each r in sheets("List").range(sheets("List").[A1], sheets("List").[A1].end(xldown))
  for each ws in worksheets
    with ws
      if .name <> "List" then
        Set Found = .UsedRange.Find(what:=r.value, LookIn:=xlValues, MatchCase:=False)

        If Not Found Is Nothing Then
           with sheets("List")
              .cells(lRowOut, "C").value = found.value
              .cells(lRowOut, "D").value = found.parent
              .cells(lRowOut, "E").value = found.address
              .cells(lrowout, "C").currentregion.createnames true, false, false, false
              if application.countif(LookupValue,r.value)>1 then lRowOut = lRowOut + 1
           end with
        End If
      end if
    end with
  next

next

When this code is executed, then use Format/Conditional Formatting... to highlight anything in LookupValue on your sheets.

Skip,

_[red][/red]

 

[wom2007]

Hi Skip, thank for your help on this. I tried it a few times and understand to a small degree what we are attempting to do, however i ran into tow errors.

The first error was a "compile error" variable not defined.

I addresed this by removing my Option Explicit statement at the very top of my code module.

The second error i received was a run time error 1004, application -defined or object defined error.

Can you please suggest how i can fix this?

 

[SkipVought]

In what statement did the error occur. Hit the Debug Button and the offending statment will be highlighted.

BTW, the BEST way to "fix" the first compile error you mentiond is to DEFINE the UNDEFINED variable. SAME PROCEDURE.

Skip,

_[red][/red]