Match cell contents exactly for find and replace based on a table

[mkae]

I am using a macro from this thread, pasted below, to replace data in one worksheet column based on a table in a second tab.

My first table has a column containing identifiers that are out of order, matching their original order in a file folder.

I want to replace these values with updated identifiers from Column 2 below, which I have mapped to the old ones in a table on the workbook's second tab. I need to retain the order from the first sheet rather than have the items be arranged sequentially like in Column1 below, which is why I am running this find and replace on the original data.

Here is the macro I am using:

Sub AccountsPStoQB()
'
' AccountsPStoQB Macro
'

'
   
    'PURPOSE: Find & Replace a list of text/values throughout entire workbook from a table

Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant


'Create variable to point to your table
  Set tbl = Worksheets("LookupTable").ListObjects("Replace")

'Create an Array out of the Table's Data
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
 
'Designate Columns for Find/Replace data
  fndList = 1
  rplcList = 2

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 2)
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
      For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then
         
        
          Columns("A").Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
       
        End If
      Next sht
  Next x


End Sub

When I run the macro, it works well for about half of the items. The issue is when there are identifiers that start with the same phrase, like 4363-2 then 4363-20 (contains 4363-2), 4363-21, 4363-22, etc. For the items that contain another item name (like 4363-20, containing 4363-2), it spits out identifiers with four digits for the final phrase, which do not exist in my table (all have three digits in the final phase, like 24-100-008, 24-100-009, etc. - not 24-053-0024). So, I think it's getting confused because these entries repeat some of the same text, and as a result it's creating new, incorrect values for them.

What I'm hoping to find is a way to get the find and replace function to match the cell contents exactly in Column 1 of the find and replace table, so that it does not try to run a replacement for 4363-2 on 4363-20 (as an example).

I would be very grateful for guidance to resolve this issue. Thank you so much.

 

[mumps]

Try:

Sub ReplaceValues()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, rng As Range, fnd As Range
    Set desWS = Sheets("Sheet1")
    Set srcWS = Sheets("Sheet2")
    For Each rng In desWS.Range("A1", desWS.Range("A" & Rows.Count).End(xlUp))
        Set fnd = srcWS.Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            rng = fnd.Offset(, 1)
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[mkae]

Try:

Sub ReplaceValues()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, rng As Range, fnd As Range
    Set desWS = Sheets("Sheet1")
    Set srcWS = Sheets("Sheet2")
    For Each rng In desWS.Range("A1", desWS.Range("A" & Rows.Count).End(xlUp))
        Set fnd = srcWS.Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            rng = fnd.Offset(, 1)
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

This worked like a charm. Thank you so much!

 

[mumps]

You are very welcome.