Forum Discussion

Trell's avatar
Trell
Copper Contributor
Jan 04, 2025

Multiple replace vba

There is a quick way via a macro or function to replace many misspelled words. I have attached an example file. In column A there is the database with the correct entries, in B the incorrect entries that refer to C separated by ";" and in C the entries that should then be replaced. If an entry is not present in the database like Pink in my file, once replaced it will remain in column B I will add it to the database later but this is a very rare evnt

 

  • Sub database()
    
    Dim arr, arr2
    Dim i As Long, j As Long, k As Long, l As Long
    Dim txt As String
    Range("D2:D1048576").Clear
    
    For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
    
    If Cells(i, 2) <> "" Then
    arr = Split(Cells(i, 2).Value, "; ")
    
    ReDim arr2(0 To UBound(arr))
    For l = 0 To UBound(arr)
    arr2(l) = Split(arr(l), " ")
    Next l
    
    For j = 0 To UBound(arr2)
    
    For k = 2 To Range("A" & Rows.Count).End(xlUp).Row
    
    Select Case arr2(j)(0)
    Case Is = "s."
        If Cells(k, 1).Value Like "*" & "strawberry" & "*" Then
        If txt = "" Then
        txt = Application.WorksheetFunction.Substitute(Cells(i, 3).Value, arr(j), Cells(k, 1).Value)
        Else
        txt = Application.WorksheetFunction.Substitute(txt, arr(j), Cells(k, 1).Value)
        End If
        Else
        End If
    Case Is = "l."
        If Cells(k, 1).Value Like "*" & "light blue" & "*" And arr2(j)(1) = "blue" Then
        If txt = "" Then
        txt = Application.WorksheetFunction.Substitute(Cells(i, 3).Value, arr(j), Cells(k, 1).Value)
        Else
        txt = Application.WorksheetFunction.Substitute(txt, arr(j), Cells(k, 1).Value)
        End If
        Else
        End If
    Case Else
        If Cells(k, 1).Value Like "*" & arr2(j)(0) & "*" Then
        If txt = "" Then
        txt = Application.WorksheetFunction.Substitute(Cells(i, 3).Value, arr(j), Cells(k, 1).Value)
        Else
        txt = Application.WorksheetFunction.Substitute(txt, arr(j), Cells(k, 1).Value)
        End If
        Else
        End If
    End Select
        
    
    Next k
    
    Next j
    If txt = "" Then
    Cells(i, 4).Value = Cells(i, 3).Value
    Else
    Cells(i, 4).Value = txt
    End If
    
    txt = ""
    Else
    Cells(i, 4).Value = Cells(i, 3).Value
    
    End If
    
    Next i
    
    End Sub

    This macro returns the intended result for my sample data in the attached file. The code would become more complicated if you had more replacement such as "L. Blue" to "Light Blue" and "Y." to "Yellow". I assume that in your screenshot "Orange 12m" in cell B4 is a typo and it should be "Orange 128m" as in cell C4.

     

    • Trell's avatar
      Trell
      Copper Contributor

      Thanks for the reply but I don't understand how it works. the macro fills in the correct version column but does not replace errors. the file was just an example as my database is made up of names also composed of cities and relative altitude followed by "m" the errors are both in the name and in the altitude or the lack of "m" for ex new york city 10m, new york, new york city 10, new york 12m ...

       

      • OliverScheurich's avatar
        OliverScheurich
        Gold Contributor

        The screenshot shows the result after running the macro. Does this return the expected result? In my understanding the errors are replaced in column D (besides avocado because that is missing in the database). I'm not sure what your actual file (database, error, test) looks like but if you want to replace any errors containing "new york" (in the error column) with for example "new york city 111m" (taken from the database column) then it should be possible to add that to the code.

         

        I've just added a few lines to the code and the second screenshot shows the result for various errors that contain "new york" in the error column.

Resources