Match and replace a string from a column in multiple ranges on multiple sheets

Question

I am trying to write a code that will search multiple ranges and match the first half of a string. if the match is true it would them replace the cell in the range with the cell in the column.

I found this code and made some changes to search multiple columns in multiple ranges on different sheets and simply replace if the first part of the string matches.

The other problem I have is that I need it to search part of the string in the cell for example

In the range; 879841.42859-MD_42885 From the column; 879841.42859-MD_43

I want it to match 879841.42859-MD then replace 879841.42859-MD_43885 with 879841.42859-MD_43

' Matchandreplace1 Macro

' Code from stack overflow cut down, no sheets involved. '

Dim ShSrc As Worksheet, ShTar As Worksheet
Dim SrcLRow As Long, TarLRow As Long, NextEmptyRow As Long
Dim RefList As Range, TarList As Range, RefCell As Range, RefColC
Dim TarCell As Range, TarColC As Range
Dim IsFound As Boolean
Dim ToFind As String

With ThisWorkbook
    Set ShSrc = .Sheets("Sheet1")
    Set ShTar1 = .Sheets("Sheet2")
    Set ShTar2 = .Sheets("Sheet3")
End With

'Get the last rows for each sheet.
SrcLRow = ShSrc.Range("A" & Rows.Count).End(xlUp).Row
TarLRow = ShTar1.Range("A" & Rows.Count).End(xlUp).Row
TarLRow = ShTar2.Range("A" & Rows.Count).End(xlUp).Row

'Set the lists to compare.
Set RefList = ShSrc.Range("A2:A" & SrcLRow)
Set TarList = ShTar1.Range("A2:A" & TarLRow)
Set TarList = ShTar2.Range("A2:A" & TarLRow)

'Initialize boolean, just for kicks.
IsFound = False

'Speed up the process.
Application.ScreenUpdating = False

'Create the loop.
For Each RefCell In RefList

    ToFind = RefCell.Value

    'Look for the value in our target column.
    On Error Resume Next
    Set TarCell = TarList.Find(ToFind)
    If Not TarCell Is Nothing Then IsFound = True
    On Error GoTo 0

    'If value exists in target column...
    If IsFound Then
        'set the value to match and highlight.
            TarColC.Value = RefColC.Value
            TarColC.Interior.ColorIndex = 4
        End If

    'Set boolean check to False.
    IsFound = False

Next RefCell
Application.ScreenUpdating = True

End Sub

Thanks,

Jerome A few snips to better describe

Answer 1

The code you have pasted has lot of syntax errors. Excel has got find and replace function which can replace the string it has found. Your requirement is to find a portion of a cell ( from source) and replace the whole cell in target

You have to append a * before and after the find string and it will replace the whole cell. Am assuming that you need to match first 15 letters of the "Find" String

    Sub FindReplaceAll1()
    Dim sht As Worksheet
    Dim fnd As Variant
    Dim rplc As Variant
    Dim Found As Range
    Dim Checkcol As Integer, rowcount As Integer, TcurrentRow As Integer, currentRow As Integer, Targrowcount As Integer
    Checkcol = 1 'Denotes A column

     Sheets("Sheet1").Select
    rowcount = Cells(Rows.Count, Checkcol).End(xlUp).Row
    For currentRow = 1 To rowcount
'Find the substring for which you need to match. Am taking first 15 characters.
    fnd = Left$(Cells(currentRow, Checkcol).Value, 15)
    rplc = Cells(currentRow, Checkcol).Value

    For Each sht In ActiveWorkbook.Worksheets
    If sht.Name = "Sheet2" Or sht.Name = "Sheet3" Then
    'Replace the whole string when a partial match is achieved
     sht.Cells.Replace what:="*" & fnd & "*", Replacement:=rplc, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    End If
    Next sht
    Next
    End Sub