VBA To Replace Long Text String Using Look-Up Table

[mjack19]

Hello,

I have a spreadsheet where I want to replace the contents of a cell with the contents of another cell based on a table. I've written a VBA code that'll work if the replacement content is less than 255 characters, but gives me an error is the replacement text is longer than that. Can anyone help me with a solution? I've included screenshots of my workbook and the code I currently have. Thank you in advance for your help!

Sub FindReplace()

For i = 2 To 500
    Worksheets("For Duping").Range("F:AE").Replace What:=Worksheets("Replacement Table").Cells(i, 1).Text, _
                                   Replacement:=Worksheets("Replacement Table").Cells(i, 2).Text, LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, MatchCase:=False
Next i

End Sub

 

[Jeffrey Mahoney]

Please try this

Sub FindReplace()
  Dim Rng As Range
  Dim Cel As Range
  Dim LUCol As Range
  Dim LUVal As String
  Dim RetVal As String
  
  Set Rng = Worksheets("For Duping").Range("F:AE")
  Set LUCol = Worksheets("Replacement Table").Range("A2:A501")
  
  For Each Cel In LUCol
    LUVal = Cel.Value
    RetVal = Cel.Offset(0, 1).Value
    
    Rng.Replace What:=LUVal, Replacement:=RetVal, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
  Next Cel

 

[Jeffrey Mahoney]

Sorry I misunderstood the 255 character limitation. Try this. It will be much slower

Sub FindReplace()
  Dim Rng As Range
  Dim Cel As Range
  Dim LUcol As Range
  Dim LUVal As String
  Dim LUCel As Range
  
  Set Rng = Worksheets("For Duping").Range("F:AE")
  Set LUcol = Worksheets("Replacement Table").Range("A2:A501")
  
  Application.Calculation = xlCalculationManual
  
  For Each Cel In Rng
    If Cel.Value <> "" Then
      For Each LUCel In LUcol
        If LUCel.Value <> "" Then
          DoEvents
          If LUCel.Value = Cel.Value Then
            Cel.Value = LUCel.Offset(0, 1).Value
            Exit For
          End If
        End If
      Next LUCel
    End If
  Next Cel
  
  
  Application.Calculation = xlCalculationAutomatic
  
End Sub

 

[mjack19]

Thank you so much, this works perfectly!