Multiple Find & Replace Macro

[Radclyffe]

I am working on a worksheet that contains thousands of addresses & intersections. I need to ensure uniformity and would like to create a macro that will help me do this. This is where you, the Excel Gurus come in!

This is a sample of the data in the column in question:

<TABLE style="WIDTH: 245pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=327 x:str><COLGROUP><COL style="WIDTH: 245pt; mso-width-source: userset; mso-width-alt: 11958" width=327><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: black 0.5pt solid; BORDER-LEFT: black 0.5pt solid; BACKGROUND-COLOR: silver; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: black 0.5pt solid; BORDER-RIGHT: black 0.5pt solid" class=xl25 height=17 width=327>INCIDENT_LOCATION</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver 0.5pt solid; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1049 MARYVILLE PIKE</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1100 BREDA DR</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1100 BREDA</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1100 TOWN VIEW</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1100 BREDA DR</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1100 BROOKS RD</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1107 DELAWARE AVE</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1202 MARYVILLE PIKE</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1202 MARYVILLE PK</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & SEVENTEENTH</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>I40 & ALCOA HWY</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & SEVENTEENTH ST</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & KINGSTON PIKE</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & KINGSTON PIKE</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & MARINE PARK</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & MARINE PARK</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & MONTLAKE DR</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & CHEROKEE TRL</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & CHEROKEE TRL</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & GINN DR</TD></TR><TR style="HEIGHT: 25.5pt" height=34><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 25.5pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=34 width=327>ALCOA HWY & W GOVERNOR JOHN SEVIER HWY</TD></TR><TR style="HEIGHT: 25.5pt" height=34><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 25.5pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=34 width=327>ALCOA HWY & W GOVERNOR JOHN SEVIER HWY</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & CHEROKEE TRL</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>ALCOA HWY & KINGSTON PIKE</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>130 STONE RD</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1300 LOVES CREEK RD</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1300 LOVES CREEK RD</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: silver 0.5pt solid; BORDER-LEFT: silver 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 245pt; HEIGHT: 12.75pt; BORDER-TOP: silver; BORDER-RIGHT: silver 0.5pt solid" class=xl26 height=17 width=327>1300 LOVES CREEK RD</TD></TR></TBODY></TABLE>
Example of a Find & Replace would be:

Find ALCOA HWY & SEVENTEENTH
Replace with ALCOA HWY & SEVENTEENTH ST

Any help with the VBA would be most appreciated!!

Thanks!

 

[Weaver]

I am working on a worksheet that contains thousands of addresses & intersections. I need to ensure uniformity and would like to create a macro that will help me do this. This is where you, the Excel Gurus come in!

This is a sample of the data in the column in question:
Example of a Find & Replace would be:

Find ALCOA HWY & SEVENTEENTH
Replace with ALCOA HWY & SEVENTEENTH ST

Any help with the VBA would be most appreciated!!

Thanks!

How would you identify what needs to be replaced with what? Given your example, how could you tell that say for instance the replace wasn't the other way round? (ie. net effect to lose the ST in all cases to create the consistency)

 

[Radclyffe]

I have a long list of all the problem entries, I imagine inputting them would mean I only have to do it once as opposed to for each problematic entry.

 

[MickG]

Try this:-
NB:- Place all the possible address Extensions (RD,PIKE etc) in the array at top of code.

[COLOR=navy]Sub[/COLOR] MG15Sep47
[COLOR=navy]Dim[/COLOR] Rng     [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, nRw [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] RDType  [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Rd      [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Temp    [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] Loc [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] Q, K
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    RDType = Array("RD", "PIKE", "PK", "VIEW", "DR", "AVE", "HWY", "TRL", "ST")
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
 Temp = vbNullString
 [COLOR=navy]For[/COLOR] Rd = 0 To UBound(RDType)
    [COLOR=navy]If[/COLOR] Mid(Trim$(Dn), InStrRev(Trim$(Dn), " ") + 1, Len(Trim$(Dn)) - InStrRev(Trim$(Dn), " ") + 1) = RDType(Rd) [COLOR=navy]Then[/COLOR]
        Loc = Trim$(Mid(Dn, 1, InStrRev(Dn, " ") - 1))
        Temp = RDType(Rd)
        [COLOR=navy]Exit[/COLOR] For
    [COLOR=navy]Else[/COLOR]
        Loc = Trim$(Dn)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Rd
    [COLOR=navy]If[/COLOR] Not .Exists(Loc) [COLOR=navy]Then[/COLOR]
       .Add Loc, Array(Dn, Temp)
    [COLOR=navy]Else[/COLOR]
        Q = .Item(Loc)
        [COLOR=navy]Set[/COLOR] Q(0) = Union(Q(0), Dn)
        [COLOR=navy]If[/COLOR] Q(1) = vbNullString [COLOR=navy]Then[/COLOR] Q(1) = Temp
        .Item(Loc) = Q
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .Keys
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] nRw [COLOR=navy]In[/COLOR] .Item(K)(0)
        nRw = K & " " & .Item(K)(1)
    [COLOR=navy]Next[/COLOR] nRw
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
MsgBox "Run"
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick