How to replace multiple strings at once

Question

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.

You could have 2 arrays, one with what you want to replace, and the other one with the replacements in the same order, and then just loop so you only write it once. Or you could turn the replace block into a function and call it giving the worksheet, what to replace and replacement. — Damian
– Damian, Commented May 7, 2019 at 6:07

Damian · Accepted Answer · 2019-05-07 06:12:55Z

1

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.

answered May 7, 2019 at 6:12

Damian

5,1741 gold badge12 silver badges22 bronze badges

Sign up to request clarification or add additional context in comments.

8 Comments

Frankis Over a year ago

Hey thanks a lot @Damian this is exactly what i am looking for ! However by the time the array gets to the "Grow" replace case there are some which are now "Growth" now and the replacement becomes "Growthth". Is there a way to prevent this.

Damian Over a year ago

you have LookAt:=xlWhole so it's impossible what you are saying, Growth <> Grow if you are matching the whole word.

Frankis Over a year ago

My apologies i had to change the code to LookAt:=xlPart as the cells contained two words rather than just the abbreviation. Edit: Altered Initial Code

Error 1004 Over a year ago

@Damian i think is not necessary to loop the second array (arrReplacement) because includes the same string. instead you could use Replacement:="Growth" as fix. Additionally, i think is good idea to declare your variable as variant

Damian Over a year ago

@Frankis change the order, put first the "biggest" words and go down from there. That's the only way. and Error 1004, I'm assuming he will have more words to replace but he only listed an example.

|

Error 1004 · Accepted Answer · 2019-05-07 07:07:24Z

0

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

answered May 7, 2019 at 7:07

Error 1004

8,2883 gold badges36 silver badges58 bronze badges

6 Comments

Error 1004 Over a year ago

@Damian take a look in my answer to understand what i mean. i have increase the number of short words and i create a case statement to choose which full should be use in the replacement.

Damian Over a year ago

I see what you mean, but imagine he has 100 replacements... It's just not worth. 2 arrays will do the job better and cleaner.

Error 1004 Over a year ago

Let s say we have this array: arrReplace = Array("ts", "Grth", "Grow","Grw" , "tes", "tet") and we start looping it. what the next array should be?

Damian Over a year ago

arrReplacement = Array("Test", "Growth", "Growth", "Growth", "Test", "Test") I don't see the problem there...

Error 1004 Over a year ago

so... imagine to have another 20 other words that have up to 5 forms of abbreviations. you will create 2 arrays with more than 100 elements?

|

Collectives™ on Stack Overflow

How to replace multiple strings at once

2 Answers 2

8 Comments

6 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

8 Comments

6 Comments

Your Answer

Sign up or log in

Post as a guest

Related