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
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.
Call it a hack, but 3 lines it is…
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
Another way…
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
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
Err.Clear
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]
Here is another approach that involves only one For loop…
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, “”)
Next
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
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).
Isnt this something you could use regex for? Here is a solution to that find state codes (certainly a little easier) but you could look around for more.
http://www.velocityreviews.com/forums/t293534-regular-expression-for-case-insensitive-usa-state-codes.html
Regex would split the string automatically, regardless of what is around it.
[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, “”)
Next
Sheets(1).Columns(1).SpecialCells(2).Offset(, 2) = WorksheetFunction.Transpose(Split(c0, “|”))
End Sub[/vb]
hans… your code fails if the name of the state is the first word(s) in the text.
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.
@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
(Alabama|Alaska|…|Wyoming)
would also address Rick’s concern about replacing Virginia before West Virginia. Once again, regular expressions rule!
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
c0 = Join(WorksheetFunction.Transpose(Sheets(1).usedrange.columns(1)), “|”)
For Each cl In Sheets(1).Columns(2).SpecialCells(2)
c0 = Replace(c0, cl, “”)
Next
Sheets(1).usedrange.Columns(1).Offset(, 2) = WorksheetFunction.Transpose(Split(replace(replace(c0,” |”,”|”),”| “,”|”), “|”))
End Sub
@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.
@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.
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
Do
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
@Rick
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, “”)
Next
.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.