CODEWITHSUNDEEP
excelvba
Frankis
Frankis

Reputation: 13

How to replace multiple strings at once

I have rows with different strings of text that contains words that are abbreviated e.g. A1 = "Grw Option", B1 ="Grth Fund", C3 ="Grow Account" rather than "Growth Option", "Growth Fund", "Growth Account".

I have the list of different abbreviations down and what i need to replace them with.

However there are about 20 other words that have up to 5 forms of abbreviations, how i have written out the complete VBA code is extremely long.

I wondering is there a possible way to list multiple strings and replace it with a single string using only a single line of code.

I have used the Find & Replace function to replace each abbreviation of "Growth".

Sub ReplaceAbbr()

Dim ws As Worksheet

    ws.Cells.Replace What:="Grw", Replacement:="Growth", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    ws.Cells.Replace What:="Grth", Replacement:="Growth", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    ws.Cells.Replace What:="Grow", Replacement:="Growth", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub

I am looking for a shorter alternative to writing this script.

Upvotes: 1

Views: 179

Answers (2)

Error 1004
Error 1004

Reputation: 8220

Option Explicit

Sub Test()

    Dim ws As Worksheet
    Dim arrReplace As Variant
    Dim strReplacement As String
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")

    arrReplace = Array("Grw", "Grth", "Grow", "ts", "tes", "tet")

    For i = LBound(arrReplace) To UBound(arrReplace)

        Select Case arrReplace(i)

            Case "Grw", "Grth", "Grow"
                strReplacement = "Growth"
            Case "ts", "tes", "tet"
                strReplacement = "Test"

        End Select

        ws.Cells.Replace What:=arrReplace(i), Replacement:=strReplacement, LookAt:=xlWhole, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Next i

End Sub

Upvotes: 0

Damian
Damian

Reputation: 5174

Option 1:

Sub Test()

    Dim ws As Worksheet
    Dim arrReplace, arrReplacement

    Set ws = ThisWorkbook.Sheets("SheetName")

    arrReplace = Array("Grw", "Grth", "Grow")
    arrReplacement = Array("Growth", "Growth", "Growth")

    For i = LBound(arrReplace) To UBound(arrReplace)
        ws.Cells.Replace What:=arrReplace(i), Replacement:=arrReplacement(i), LookAt:=xlWhole, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next i

End Sub

Option 2:

Function Replacement(ws As Worksheet, Replace As String, Replacement As String)

    ws.Cells.Replace What:=Replace, Replacement:=Replacement, LookAt:=xlWhole, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Function
Private Sub Test2()

    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("SheetName")

    Call Replacement(ws, "Grw", "Growth")

End Sub

In option 1 you could also have somewhere in a sheet both lists in columns and assign the arrays to these columns to make it easier.

In option 2 you could also use loops like in option 1.

Upvotes: 1

Related Questions