Is there a way to set a macro up that would loop through a list and find and replace multiple words in a cell?
I have a list of addresses and a list of acceptable USPS abbreviations. I would like Excel to look at the address and loop through the list of abbreviations and apply any that fit (i.e. change Street to St and change Northwest to NW) I am attaching a sample of the spreadsheet for your reference.
I would go with a loop within a loop.
Loop through each required column on the main sheet and for each column loop through all the variations in the abbreviations sheet.
One thing to watch out for is to pad the keywords with a space else 28 Census Drive is going to look odd after substituting CEN for CTR and getting 28 CTRSUS DRV.
You can apply your uppercase at the same time.
If you go with the For each method, you will be less likely to get stuck in an infnite loop.
As you are completing new columns, you could use the offset from your activecell to place the corrected data.
All of those methods are in the code I posted for another user.
Okay, here is what I tried, but it isn't working. I keep getting an error message that states "For control variable already in use". Also, for some reason it is enclosing my cell references in single quotes. What am I doing wrong?
Code:
Dim addr As Integer
Dim abr As Integer
Dim newaddr As String
Dim cell As Range
addr = 1
abr = 1
For Each cell In Range("Address_Scrubber!D2:D650")
If Len(cell.Value) >= 0 Then
addr = addr + 1
For Each cell In Range("Abbreviations!G2:G540")
abr = abr + 1
ActiveCell.FormulaR1C1 = _
"=SUBSTITUTE(Address_Scrubber!D" & addr & ",Abbreviations!G" & abr & ",Abbreviations!H" & abr & ")"
newaddr = ActiveCell.Value
Next cell
End If
Next cell
addr = 1
abr = 1
newaddr = ""
End Sub
That is because you are using the same cell object in both the loops. Create another cell range, cell1 perhaps, and use that in one of the loops if you need to.
and even if you had it right, I have no idea as to what the SUBSTITUTE would look like.
I would build the string so I could debug print it to make sure it is correct, then assign it to the cell.formula
For things like this, I take it in small steps, one at a time.
For the time being, hard code the range, then when it is working, look for the loop.
This is what I would be thinking of doing.
Select a column on the data sheet.
Find the number of rows to process.
Start a loop for the cells in the abbreviation sheet
Assign the original value and the replacement value to strings
For each cell value do a find and replace on the selection in the data sheet.
Now select the next cell in the abbreviations and repeat, and keep on repeating until you get to the end of the abbreviations.
Then move on to the next column.
If you record a macro, select a column of data, and do a manual find and replace and stop the macro, that will give you the basis for the code. The macroes are a little long winded but are great for the syntax required.
As you want the data in other columns, copy the source data first and work on the end result column. That way you can compare the changes.
I generally look as to how I would do it manually, then work out how to automate it as much as possible. So think on how you would do it manually, then try and replicate that. Even recording macroes for parts of it will help as well.
Hopefully your column structure will remain the same, it is just the number of rows to process that will change?
I do not think you can use formulae, you have to make the changes on the fly in VBA and put the results in the column.
I'll try and look tomorrow and see if I have anything that works more closely to what you are trying to accomplish. Even if I find something it will still need editing.
Okay, here is what I tried, but it isn't working. I keep getting an error message that states "For control variable already in use". Also, for some reason it is enclosing my cell references in single quotes. What am I doing wrong?
Code:
Dim addr As Integer
Dim abr As Integer
Dim newaddr As String
Dim cell As Range
addr = 1
abr = 1
For Each cell In Range("Address_Scrubber!D2:D650")
If Len(cell.Value) >= 0 Then
addr = addr + 1
For Each cell In Range("Abbreviations!G2:G540")
abr = abr + 1
ActiveCell.FormulaR1C1 = _
"=SUBSTITUTE(Address_Scrubber!D" & addr & ",Abbreviations!G" & abr & ",Abbreviations!H" & abr & ")"
newaddr = ActiveCell.Value
Next cell
End If
Next cell
addr = 1
abr = 1
newaddr = ""
End Sub
Thinking more on this, I believe you only need formulae for most of this and just the vba for the shortening of the address.? and possibly uppercase.
Here is something to start with, however, you are going to have to tidy up your abbreviations and have the longest first.
You will see the effect when you run his code
Code:
Sub Abbreviate()
Dim cell As Range
Dim strSearch As String, strReplace As String
Dim lngRows As Long
'Get last row number in address sheet
Sheets("Address Scrubber").Select
lngRows = Range("D" & Rows.Count).End(xlUp).Row
'Copy street data to column L
Range("D:D").Select
Selection.Copy
Range("L:L").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Convert to uppercase
For Each cell In Range("L2:L" & lngRows)
cell.Value = UCase(cell.Value)
Next
'Now do the swaps
For Each cell In Sheets("Abbreviations").Range("G2:G540")
strSearch = " " & cell.Value
strReplace = " " & cell.Offset(0, 1)
Sheets("Address Scrubber").Range("L:L").Replace What:=strSearch, Replacement:=strReplace, LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Next
End Sub
The thread I posted shows how get the last line of data in a column.
I would use that to change the values to uppercase as needed.
I found that if I had formulae in column L, the substitution did not work
Very neat, arnelgp
I must admit my attempt also needs tweaking, but I don't think you should combine the states with the other abbreviations as Wyoming can be and is changed to WAY ?
AFAIK it should be WY ?
Gasman:
Just tested it again abd it does replace Drive with DR.
LadyDi:
On vbe, doublr click Thisworkbook on oroj explorer.
On the Editor window there are two combox in top.
The left combo has items like (General) and Workbook.
Choose Workbook.
This will add WorkBook_Open() event.
Inside the sub, type:
Private sub workbook_open()
Call theFuncName()
End sub
arnelgp,
I wasn't saying it did not. What I was asking is DRIV comes before DRIVE in the range, so I would have expected it to replace in the word DRIVE, DRIV with DR giving DRE.
That is what happened to my attempt, which made me realise that the order in the substitute range can matter.?