Selection.Replace in VBA macro

Question

I need to change the code so that LMX220MA (KIT) becomes X220MA, LMX220MA becomes X220MA, LMX220 (KIT) becomes X220MB, LMX220 becomes X220MB.

Tried removing LMX22 Selection.Replace line and then adding:

   Range("H2").Select
   ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],6)"
   Selection.Copy
   Range("G1").Select
   Selection.End(xlDown).Select
   ActiveCell.Offset(, 1).Select
   Range(Selection, Selection.End(xlUp)).Select
   ActiveSheet.Paste
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
   Selection.Replace What:="LMX220", Replacement:="X220MB", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False

   Range("H2").Select
   ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],8)"
   Selection.Copy
   Range("G1").Select
   Selection.End(xlDown).Select
   ActiveCell.Offset(, 1).Select
   Range(Selection, Selection.End(xlUp)).Select
   ActiveSheet.Paste
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
   SkipBlanks
   Selection.Replace What:="LMX220MA", Replacement:="X220MA", 
    LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False

and so on.

Original code:

    ' Insert Model Number_Carrier column
    Sheets("Data_Upload").Select
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Model Number_Carrier"

    ' Fill Model Number_Carrier field
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],5)"
    Selection.Copy
    Range("G1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("H:H").Select
    Selection.Replace What:="LMX21", Replacement:="X210MA", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="MW41M", Replacement:="_", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Q710M", Replacement:="Q710MS", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="LMQ61", Replacement:="Q610MA", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="LMQ71", Replacement:="_", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="X410M", Replacement:="X410MK", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="LMX22", Replacement:="X220MB", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Range("A1").Select

It will fill ModelNumber_Carrier cells with what is in the cell in Model column (LMX220 becomes LMX220) and "ModelNumber_Carrier" column becomes "Model" even though ModelNumber_Carrier column coding was left alone.

Returning compile error: end sub error when I change it to this:

Sub MPCSWeeklyReturnReason()
'
' MPCS_Return_Reason Macro
'


' Prevents screen refreshing.
        Application.ScreenUpdating = False

' Check if procedure has already run
    Dim rCell As String

    rCell = ActiveSheet.Range("H1").Text

    If InStr(1, rCell, "Model Number_Carrier") Then

        Application.ScreenUpdating = True
        MsgBox "Macro already run."

        Exit Sub

    Else

' Combine all worksheets to one for upload
    Dim J As Integer
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Data_Upload"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    For J = 2 To Sheets.Count
    Sheets(J).Activate
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
    Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next

' Insert Model Number_Carrier column
    Sheets("Data_Upload").Select
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Model Number_Carrier"

    ' Fill Model Number_Carrier field
Sub FindReplaceAll()
' This will find and replace text in all sheets
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim fnd1 As Variant
Dim rplc1 As Variant
Dim fnd2 As Variant
Dim rplc2 As Variant
Dim fnd3 As Variant
Dim rplc3 As Variant

'Set the criteria to change here
fnd = "LMX220MA (KIT)"
rplc = "X220MA"
fnd1 = "LMX220MA"
rplc1 = "X220MA"
fnd2 = "LMX220 (KIT)"
rplc2 = "X220MB"
fnd3 = "LMX220"
rplc3 = "X220MB"


For Each sht In ActiveWorkbook.Worksheets

    sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    sht.Cells.Replace what:=fnd1, Replacement:=rplc1, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    sht.Cells.Replace what:=fnd2, Replacement:=rplc2, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    sht.Cells.Replace what:=fnd3, Replacement:=rplc3, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

Next sht

End Sub

' ESN Concantenate Fix
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=TEXT(,RC[-11])"
    Selection.Copy
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 16).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-1]), RC[-12], RC[-1])"
    Selection.Copy
    Range("Q2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("Q:R").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select

' TRIM Reason and SUBReason spaces
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-4])"
    Selection.Copy
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 16).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("Q:Q").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select


' Enables screen refreshing.
    Application.ScreenUpdating = True

' Save the Workbook
    ActiveWorkbook.Save

    End If

End Sub

Answer 1

Here try this. It will go through all of the sheets in your workbook and find and replace all cases with the text you specified. I was unsure if you wanted to have the "(KIT)" included so I left it in, but feel free to adjust as necessary.

Sub FindReplaceAll()
' This will find and replace text in all sheets
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim fnd1 As Variant
Dim rplc1 As Variant
Dim fnd2 As Variant
Dim rplc2 As Variant
Dim fnd3 As Variant
Dim rplc3 As Variant

'Set the criteria to change here
fnd = "LMX220MA (KIT)"
rplc = "X220MA"
fnd1 = "LMX220MA"
rplc1 = "X220MA"
fnd2 = "LMX220 (KIT)"
rplc2 = "X220MB"
fnd3 = "LMX220"
rplc3 = "X220MB"


For Each sht In ActiveWorkbook.Worksheets

    sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    sht.Cells.Replace what:=fnd1, Replacement:=rplc1, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    sht.Cells.Replace what:=fnd2, Replacement:=rplc2, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    sht.Cells.Replace what:=fnd3, Replacement:=rplc3, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

Next sht

End Sub

Answer 2

Took another look at this and you can also do it this way by using arrays. Similar to my other answer with this one if I left in the "(KIT)" that shouldn't have been there or anything just adjust as necessary but the syntax is there.

Sub FindReplaceAll()

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

'Set the criteria to change here
fndList = Array("LMX220MA (KIT)", "LMX220MA", "LMX220 (KIT)", "LMX220")
rplcList = Array("X220MA", "X220MA", "X220MB", "X220MB")

'Loop through each item in Array lists
   For x = LBound(fndList) To UBound(fndList)
    'Loop through each worksheet in ActiveWorkbook
        For Each sht In ActiveWorkbook.Worksheets
            sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        Next sht

    Next x

End Sub