Find and replace for multiple terms

[jeremyr863]

Hello all,

I need to perform a find and replace on multiple values that I'm sure can be coded in excel.

I have a list of address that have certain words that need to be replaced with a '~' symbol and some terms replaced with their abbreviation.
For instance:

Addr	addr_2
123 abc street apt 5	123 abc ST ~ 5
456 qwe lane unit 5	456 qwe LN ~ 5
678 mno boulevard rm 4	678 mno BLVD ~4

Here we are replace apt, unit , and rm with the ~ symbol. Later the text to column function is used to eliminate the truncating value.
Also note street, lane, and boulevard have been replaced with ST, LN, and BLVD.

Im wondering if some sort of code can be used to knock out all 6 find and replaces at once.
I have many more terms to add and im thinking your help can aid as a template.

Much thanks.

 

[kweaver]

I thought a UDF might be a better approach if you have add'l changes possible. Modified from something I saw some time ago and used for myself.

Function MultiReplace(strInput As String, rngFind As Range, rngReplace As Range) As String

Dim strTemp As String, strFind As String, strReplace As String, cellFind As Range
Dim lngColFind As Long
Dim lngRowFind As Long
Dim lngRowReplace As Long
Dim lngColReplace As Long

lngColFind = rngFind.Columns.Count
lngRowFind = rngFind.Rows.Count
lngColReplace = rngFind.Columns.Count
lngRowReplace = rngFind.Rows.Count

strTemp = strInput

If Not ((lngColFind = lngColReplace) And (lngRowFind = lngRowReplace)) Then
    MultiReplace = CVErr(xlErrNA)
    Exit Function
End If

For Each cellFind In rngFind

    strFind = cellFind.Value
    strReplace = rngReplace(cellFind.Row - rngFind.Row + 1, cellFind.Column - rngFind.Column + 1).Value
    strTemp = Replace(strTemp, strFind, strReplace)

Next cellFind

MultiReplace = strTemp

End Function

Book2
	A	B	C	D	E
1	Addr	Using UDF		Original	Replacement
2	123 abc street apt 5	123 abc ST ~ 5		Street	ST
3	456 qwe lane unit 5	456 qwe LN ~ 5		street	ST
4	678 mno boulevard rm 4	678 mno BLVD ~ 4		Lane	LN
5	1 Main Street Suite 10	1 Main ST ~ 10		lane	LN
6				Boulevard	BLVD
7				boulevard	BLVD
8				apt	~
9				unit	~
10				rm	~
11				room	~
12				Suite	~
13				suite	~
Addresses

Cell Formulas
Range	Formula
B2:B5	B2	=MultiReplace(A2,D$2:D$13,E$2:E$13)

 

[EXCEL MAX]

According to your example...

Sub Eliminate()

    Dim vR As Range, vA, vS As Long, vEliminate, vT As String
   
    For Each vR In Range("A2", Cells(Rows.Count, "A").End(xlUp))
        vA = Split(vR, " ")
        vT = vA(2)
        vEliminate = Array("A", "E", "I", "O", "U", "R")
        For vS = 0 To UBound(vEliminate)
            vA(2) = UCase(Replace(UCase(vA(2)), vEliminate(vS), ""))
            vA(3) = ""
        Next vS
        If Len(vT) <= 6 Then vA(2) = Left(vA(2), 2)
        vR.Offset(0, 3) = Join(vA, " ")
    Next vR
   
End Sub

 

[jeremyr863]

@kweaver
This looks promising however I am not sure how to enable this code. I dont have experience with vba.

As an end results, im looking to have a single, edited cell that can be used to identify addresses.
For example, I would use the 'cleaned' cell with 123 abc ST or 1 Main ST.

 

[kweaver]

ALT+F11 puts you into the VBA screen. Right click on Thisworkbook and insert a module and into that paste the code.

 

[jeremyr863]

got it, i didnt know simply exiting the VBA window would save your code and allow module use.
Thanks!