Multiple Substitute VBA

In regard to Multiple Substitute Formula, here’s one way to do it in VBA.

Sub RemoveStates()
    Dim rInput As Range
    Dim rStates As Range
    Dim vaInput As Variant
    Dim vaStates As Variant
    Dim i As Long, j As Long
    Dim sTemp As String
    Set rInput = Sheet1.Range(“A1”, Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp))
    Set rStates = Sheet1.Range(“B1”, Sheet1.Cells(Sheet1.Rows.Count, 2).End(xlUp))
    vaInput = rInput.Value
    vaStates = rStates.Value
    For i = LBound(vaInput, 1) To UBound(vaInput, 1)
        For j = LBound(vaStates, 1) To UBound(vaStates, 1)
            vaInput(i, 1) = Replace(vaInput(i, 1), vaStates(j, 1), “”, , , vbBinaryCompare)
        Next j
        vaInput(i, 1) = Trim(vaInput(i, 1))
    Next i
    rInput.Offset(, 2).Value = vaInput
End Sub

I predict that someone will post some code in the comments that does this in three lines, so stay tuned.

Posted in Uncategorized

15 thoughts on “Multiple Substitute VBA

  1. Call it a hack, but 3 lines it is…

    Sub RemoveStatesInThreeLinesofCode()
        Range(“c1:c” & Range(“b” & Rows.Count).End(xlUp).Row).Formula = “=TRIM(SUBSTITUTE(A1,INDEX($B:$B,IF(ISNA(MATCH(FALSE,ISERR(FIND($B:$B,A1)),FALSE)),0,MATCH(FALSE,ISERR(FIND($B:$B,A1)),FALSE)),1),”“”“))”
    End Sub
  2. Another way…

    Sub RemoveStates()
        Dim rInput As Range: Dim rStates As Range: Dim vaInput As Variant: Dim vaStates As Variant: Dim i As Long, j As Long: Dim sTemp As String: Set rInput = Sheet1.Range(“A1”, Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp)): Set rStates = Sheet1.Range(“B1”, Sheet1.Cells(Sheet1.Rows.Count, 2).End(xlUp)): vaInput = rInput.Value: vaStates = rStates.Value: For i = LBound(vaInput, 1) To UBound(vaInput, 1): For j = LBound(vaStates, 1) To UBound(vaStates, 1): vaInput(i, 1) = Replace(vaInput(i, 1), vaStates(j, 1), “”, , , vbBinaryCompare):   Next j: vaInput(i, 1) = Trim(vaInput(i, 1)): Next i: rInput.Offset(, 2).Value = vaInput
    End Sub
  3. Not 3 lines, but I’d prefer to select the range I want to alter before running the macro, then be able to select the range containing the substrings to remove as part of the macro.

    [VB]Sub foo()
    Dim vr As Range, sr As Range, vc As Range, sc As Range

    If Not TypeOf Selection Is Range Then Exit Sub
    Set vr = Selection

    On Error Resume Next
    Set sr = Application.InputBox( _
    Prompt:=”Enter range of words/phrases to remove from ” & vr.Address(0, 0, , 1), _
    Type:=8 _
    If Err.Number 0 Then
    Exit Sub
    End If
    On Error GoTo 0

    For Each vc In vr
    For Each sc In sr
    If ” ” & vc.Value2 & ” ” Like “* ” & sc.Value2 & ” *” Then _
    vc.Value2 = Replace(vc.Value2, sc.Value2, ” “)
    Next sc
    vc.Value2 = Application.WorksheetFunction.Trim(vc.Value2)
    Next vc

    End Sub[/VB]

  4. Here is another approach that involves only one For loop…

    Sub RemoveStates()
      Dim S As String
      Dim R As Range, rInput As Range, rStates As Range
      Set rInput = Sheet1.Range(“A1”, Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp))
      Set rStates = Sheet1.Range(“B1”, Sheet1.Cells(Sheet1.Rows.Count, 2).End(xlUp))
      S = Join(Application.Transpose(rInput), Chr(1))
      For Each R In rStates
        S = Replace(S, R.Value, “”)
      rInput.Offset(0, 2).Value = Application.Transpose(Split(Replace(Replace(Application. _
                                  Trim(S), ” “ & Chr(1), Chr(1)), Chr(1) & ” “, Chr(1)), Chr(1)))
    End Sub
  5. Dick,

    I notice your states’ list appears to be in alphabetical order… you must break that for West Virginia making sure it appears earlier in the list than Virginia; otherwise, for text containing West Virginia, only the Virginia would end up getting replaced (leaving the word West behind).

  6. [vb]Sub tst()
    c0 = Join(WorksheetFunction.Transpose(Sheets(1).Columns(1).SpecialCells(2)), “|”)
    For Each cl In Sheets(1).Columns(2).SpecialCells(2)
    c0 = Replace(c0, ” ” & cl, “”)
    Sheets(1).Columns(1).SpecialCells(2).Offset(, 2) = WorksheetFunction.Transpose(Split(c0, “|”))
    End Sub[/vb]

  7. hans… one other possible problem I see with your code… it will fail if there is one or more blank rows in between the data in Column A.

  8. @Rick – one explicit loop, but each Application.Transpose call is an implicit loop, so your code’s runtime may reflect 3 loops rather than 1 or 2.

    @f – yes, you could use regular expressions, but the regex needed would be quite long. Something structured like


    would also address Rick’s concern about replacing Virginia before West Virginia. Once again, regular expressions rule!

  9. Rick,

    I didn’t see any cell in Dick’s ‘problem’ beginning with the name of a state.
    But nevertheless.
    And to prevent areas in column 1

    Sub tst()
    c0 = Join(WorksheetFunction.Transpose(Sheets(1).usedrange.columns(1)), “|”)
    For Each cl In Sheets(1).Columns(2).SpecialCells(2)
    c0 = Replace(c0, cl, “”)
    Sheets(1).usedrange.Columns(1).Offset(, 2) = WorksheetFunction.Transpose(Split(replace(replace(c0,” |”,”|”),”| “,”|”), “|”))
    End Sub
  10. @fzz…. Well, that’s true, Transpose does do a “behind the scenes” loop, but that can also be said for Replace, InStr, Trim, Array, Split, and several other function calls as well, so I’m not that sure we should be counting them as “loops” per se.

  11. @hans… That looks good now, except for your not Dim’ming your variables, that is [grin]. Your overall structure is similar to the code I posted (for example, your last line, except for the delimiter, looks a lot like the one I had to use in my code), but your “set up” for it is more compact. I especially like how you used SpecialCells function (although I would have used the predefined constant xlCellTypeConstants rather than the “magic number” 2 for its argument) even though using it does obfuscate the fact that the list of states is being iterated.

  12. I guess mine is a relatively long one. But it works.

    Function test(ByRef rng_lookup As Range, ByRef rng_find As Range) As String

    Dim m As Variant, str_result As String, bln_matched As Boolean, int_count As Integer, arr_temp As Variant

    arr_temp = Split(rng_lookup.Value)
    str_result = rng_lookup.Value
    For Each m In rng_find.Value
    If InStr(m, arr_temp(int_count)) > 0 Then
    ‘=-= Example:
    ‘=-= m = South Dakota
    ‘=-= arr_temp(int_count) = South
    If InStr(rng_lookup.Value, m) > 0 Then
    ‘=-= Example:
    ‘=-= rng_lookup.value = Sofas South Dakota
    ‘=-= m = South Dakota
    str_result = Replace(str_result, m, vbNullString)
    bln_matched = (InStr(rng_lookup.Value, m) – 1) + Len(m) = Len(rng_lookup.Value)
    Exit For
    End If
    End If
    Next ‘=-= m
    int_count = int_count + 1
    Loop Until bln_matched Or int_count > UBound(arr_temp) ‘=-= will exit if the seach is done for all the chars or length of the lookup words reached the max after replacing the word

    If str_result = vbNullString Then str_result = rng_lookup.Value
    ‘xx Debug.Print bln_matched & ” -> ” & str_result
    test = str_result

    End Function

  13. @Rick

    Sub tst4()
      Sheet1.Columns(1).SpecialCells(2).Copy Sheet1.Cells(1, 3)
      With Sheet1.Columns(3).SpecialCells(2)
        c0 = ” ” & Join(WorksheetFunction.Transpose(.Value), “| “)
        For Each cl In Sheet1.Columns(2).SpecialCells(2)
          c0 = Replace(c0, ” ” & cl, “”)
        .Value = WorksheetFunction.Transpose(Split(Trim(c0), “| “))
      End With
    End Sub

    using 2 instead of xlcelltypeconstants makes the code code more robust, because it can also be run from other programs than Excel (for instance Word, Outlook, Access, etc.).
    Copying filled cells in column A to column C reduces the string c0 to its minimum.

Leave a Reply

Your email address will not be published. Required fields are marked *