I have a list of terms in one sheet (Find List)
I have a column of text data "Replace Data" in another sheet that I need to search for exact full words/phrases in the Find List and if multiple instances exist in the text data of Replace Data, I need to eliminate all instances of that exact/full word or phrase except for the first instance.
Find List Term
I find terms
Replace Data Text
Joe, you have to believe I find terms and will without a doubt I find terms.
Result Desired
Joe, you have to believe I find terms and will without a doubt .
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
I have a column of text data "Replace Data" in another sheet that I need to search for exact full words/phrases in the Find List and if multiple instances exist in the text data of Replace Data, I need to eliminate all instances of that exact/full word or phrase except for the first instance.
Find List Term
I find terms
Replace Data Text
Joe, you have to believe I find terms and will without a doubt I find terms.
Result Desired
Joe, you have to believe I find terms and will without a doubt .
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
