OK, so
- capitalisation must also match.
- punctuation must match. I think this will be tricky. To confirm, what about these?
6. Please confirm the Result desired for this scenario
Find List Term
Tom
Replace Data Text
I like Tom and Tom's cat
Sue likes Tom and I like Tom, and his cat
Sue likes Tom. I like Tom.
Do you like Tom? I like Tom.
Result: I am assuming each line is a separate cell here.
I like Tom and 's cat
Sue likes Tom and I like , and his cat
Sue likes Tom. I like .
Do you like Tom? I like .
Yes, looking for exact matches including punctuation and caps. However it can/needs be partial string replace. I know they will be exact matches because I am already running a match/replace loop to get from many different related terms down to fewer of these standardized terms (Tom or Thomas or Thom or Tomas all change to Tom) first. Then this step I am inquire about will reduce down to get rid of all of the duplicates that mean the same thing but make the length of the cell excessive.
The Find/Replace code works very well now- perhaps a tweak is possible to change matches for each term after the first match inside the same cell as "" instead of a whole new Macro to call upon in the process.
I am a novice so any ideas are welcome.
Here is the current code that does the initial changing of many terms down to fewer standardized terms.
Sub FindReplaceJobTitleSkills()
If (MsgBox("Do you want to continue find & replacement. Make sure you have backup of this file.", vbYesNo, "Message") = vbNo) Then
Exit Sub
End If
Dim myDataSheet As Worksheet
Dim myReplaceSheet As Worksheet
Dim myLastRow As Long
Dim myRow As Long
Dim myFind As String
Dim myReplace As String
' Specify name of Data sheet
Set myDataSheet = Sheets("Processed Compilation Tab")
' Specify name of Sheet with list of replacements
Set myReplaceSheet = Sheets("Job Title Append")
' Assuming list of replacement start in column A on row 2, find last entry in list
myLastRow = myReplaceSheet.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
myReplaceSheet.Activate
' Loop through all list of replacments
For myRow = 2 To myLastRow
' Get find and replace values (from columns A and B)
myFind = myReplaceSheet.Cells(myRow, "B")
myReplace = myReplaceSheet.Cells(myRow, "C")
' Start at top of data sheet and do replacements
myDataSheet.Activate
Range("A1").Select
' Ignore errors that result from finding no matches
On Error Resume Next
' Do all replacements on column A of data sheet
myDataSheet.Columns("A:A").Replace What:=myFind, Replacement:=myReplace, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
myDataSheet.Columns("B:B").Replace What:=myFind, Replacement:=myReplace, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
myDataSheet.Columns("I:I").Replace What:=myFind, Replacement:=myReplace, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Application.StatusBar = myRow & "" & myLastRow
' Reset error checking
On Error GoTo 0
Next myRow
Application.ScreenUpdating = True
MsgBox "Replacements complete!"
End Sub
