Macro and/or Formula to Find and Replace (1 Viewer)

LadyDi

Registered User.
Local time
Today, 03:58
Joined
Mar 29, 2007
Messages
894
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.


Any assistance would be greatly appreciated.
 

Attachments

  • Address Scrubber.xlsx
    30.9 KB · Views: 116

Gasman

Enthusiastic Amateur
Local time
Today, 10:58
Joined
Sep 21, 2011
Messages
14,038
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.


HTH
 

LadyDi

Registered User.
Local time
Today, 03:58
Joined
Mar 29, 2007
Messages
894
Would you be able to give me an example of what it should look like?

Unfortunately, I have had trouble in the past when I try to write a loop - somehow, I frequently end up with an infinite loop and I don't want that.
 

Gasman

Enthusiastic Amateur
Local time
Today, 10:58
Joined
Sep 21, 2011
Messages
14,038
Have a look at post 9 onwards in this thread
https://access-programmers.co.uk/forums/showthread.php?t=300257

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.


HTH
 

LadyDi

Registered User.
Local time
Today, 03:58
Joined
Mar 29, 2007
Messages
894
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
 

Gasman

Enthusiastic Amateur
Local time
Today, 10:58
Joined
Sep 21, 2011
Messages
14,038
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.

You have to use the correct syntax

http://www.informit.com/articles/article.aspx?p=2021718&seqNum=5

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.

HTH

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
 

Gasman

Enthusiastic Amateur
Local time
Today, 10:58
Joined
Sep 21, 2011
Messages
14,038
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

HTH
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:58
Joined
May 7, 2009
Messages
19,169
open Module1 and put the Range to convert.
Press F5 while the cursor is inside the function fncScrub().

See also Module3. this is the actual replacer function.

Rename the extension to .xlsm
 

Attachments

  • Address Scrubber.xls
    35.8 KB · Views: 124
Last edited:

LadyDi

Registered User.
Local time
Today, 03:58
Joined
Mar 29, 2007
Messages
894
This is perfect. Thank you so much.


I have one more question for you. Is there any way to set this to run each time the workbook is opened?
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:58
Joined
May 7, 2009
Messages
19,169
You have to call the function on thisworkbook, open event.
 

Gasman

Enthusiastic Amateur
Local time
Today, 10:58
Joined
Sep 21, 2011
Messages
14,038
open Module1 and put the Range to convert.
Press F5 while the cursor is inside the function fncScrub().

See also Module3. this is the actual replacer function.

Rename the extension to .xlsm


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 ?
 
Last edited:

Gasman

Enthusiastic Amateur
Local time
Today, 10:58
Joined
Sep 21, 2011
Messages
14,038
arnelgp,

For my benefit please.?


Why does the substitution of DRIV for DR does not get carried out in the word DRIVE?
 

LadyDi

Registered User.
Local time
Today, 03:58
Joined
Mar 29, 2007
Messages
894
I know how to call a function in Access. Unfortunately, I've never done it in Excel. Could you tell me how to call this function in Excel on Open?


You have to call the function on thisworkbook, open event.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:58
Joined
May 7, 2009
Messages
19,169
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

Save, close and re-open the workbook.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:58
Joined
May 7, 2009
Messages
19,169
About wyoming, just reverse the position of the two loops, Common word first, then the States.
 

Gasman

Enthusiastic Amateur
Local time
Today, 10:58
Joined
Sep 21, 2011
Messages
14,038
Gasman:
Just tested it again abd it does replace Drive with DR.

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.?


Edit: Not to worry, I have fiound out why now.
 
Last edited:

Users who are viewing this thread

Top Bottom