Modify Macro: Change text only if text is found at END of cell?

J

jeffcoleky

Active Member
Joined
May 24, 2011
Messages
274
Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


With Sheets("ListFilter").Columns("M:V")        ' change to columns to replace string


Application.DisplayAlerts = False


    .Replace What:=" Lane", Replacement:=" Ln", SearchOrder:=xlByColumns, MatchCase:=True
    .Replace What:=" Road", Replacement:=" Rd", SearchOrder:=xlByColumns, MatchCase:=True
    .Replace What:=" Avenue", Replacement:=" Ave", SearchOrder:=xlByColumns, MatchCase:=True
    .Replace What:=" Trace", Replacement:=" Trce", SearchOrder:=xlByColumns, MatchCase:=True
    .Replace What:=" Circle", Replacement:=" Cir", SearchOrder:=xlByColumns, MatchCase:=True
    .Replace What:=" Boulevard", Replacement:=" Blvd", SearchOrder:=xlByColumns, MatchCase:=True
    .Replace What:=" Court", Replacement:=" Ct", SearchOrder:=xlByColumns, MatchCase:=True
    [B].Replace What:=" Street", Replacement:=" St", SearchOrder:=xlByColumns, MatchCase:=True[/B]

End With
Application.DisplayAlerts = True
End Sub

Unfortunately, this macro will change the data if the "What:=" text is found ANYWHERE in the cell. Is there any way to easily modify specific lines so that it will only replace the text if the text is found at the END of the cell?

For example:

"123 Main Street" <-- No problem changing to "123 Main St"

But...

"555 Third Street Road" >> Converts to >> "555 Third St Rd" (A problem).
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
Hi Jeff. Try this macro. It has to loop through all the cells in your range so I'm not sure how fast it will be. There may be a more efficient way to do it.
Code: 
Sub ReplaceLastWord()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim Str As Range
    For Each Str In Range("M2:V" & LastRow)
        Select Case Trim(Right(Str, Len(Str) - (InStrRev(Str, " ") - 1)))
            Case "Lane"
                Str.Replace What:="Lane", Replacement:="Ln", MatchCase:=True
            Case "Road"
                Str.Replace What:="Road", Replacement:="Rd", MatchCase:=True
            Case "Avenue"
                Str.Replace What:="Avenue", Replacement:="Ave", MatchCase:=True
            Case "Trace"
                Str.Replace What:="Trace", Replacement:="Trce", MatchCase:=True
            Case "Circle"
                Str.Replace What:="Circle", Replacement:="Cir", MatchCase:=True
            Case "Boulevard"
                Str.Replace What:="Boulevard", Replacement:="Bvld", MatchCase:=True
            Case "Court"
                Str.Replace What:="Court", Replacement:="Ct", MatchCase:=True
            Case "Street"
                Str.Replace What:="Street", Replacement:="St", MatchCase:=True
        End Select
    Next Str
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
jeffcoleky,

Here is another macro for you to consider that does not do any looping.

Sample raw data in worksheet ListFilter (not all columns are shown for brevity):


Excel 2007
MV
2Lane Lane LaneLane Lane Lane
3Road Road RoadRoad Road Road
4Avenue Avenue AvenueAvenue Avenue Avenue
5Trace Trace TraceTrace Trace Trace
6Circle Circle CircleCircle Circle Circle
7Boulevard Boulevard BoulevardBoulevard Boulevard Boulevard
8Court Court CourtCourt Court Court
9Street Street StreetStreet Street Street
10Lane Lane LaneLane Lane Lane
11Road Road RoadRoad Road Road
12Avenue Avenue AvenueAvenue Avenue Avenue
13Trace Trace TraceTrace Trace Trace
14Circle Circle CircleCircle Circle Circle
15Boulevard Boulevard BoulevardBoulevard Boulevard Boulevard
16Court Court CourtCourt Court Court
17Street Street StreetStreet Street Street
18
ListFilter


After the macro:


Excel 2007
MV
2Lane Lane LNLane Lane LN
3Road Road RDRoad Road RD
4Avenue Avenue AveAvenue Avenue Ave
5Trace Trace TrceTrace Trace Trce
6Circle Circle CirCircle Circle Cir
7Boulevard Boulevard BlvdBoulevard Boulevard Blvd
8Court Court CTCourt Court CT
9Street Street StStreet Street St
10Lane Lane LNLane Lane LN
11Road Road RDRoad Road RD
12Avenue Avenue AveAvenue Avenue Ave
13Trace Trace TrceTrace Trace Trce
14Circle Circle CirCircle Circle Cir
15Boulevard Boulevard BlvdBoulevard Boulevard Blvd
16Court Court CTCourt Court CT
17Street Street StStreet Street St
18
ListFilter


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code: 
Sub UpdateAddressEnd()
' hiker95, 03/20/2015, ME843710
Dim lr As Long, rng As Range
Application.ScreenUpdating = False
With Sheets("ListFilter")
  lr = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  Set rng = .Range("M2:V" & lr)
  rng = Evaluate(Replace("IF(RIGHT(@,5)="" Lane"",REPLACE(@,LEN(@)-4,5,"" LN""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,5)="" Road"",REPLACE(@,LEN(@)-4,5,"" RD""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Avenue"",REPLACE(@,LEN(@)-6,7,"" Ave""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,6)="" Trace"",REPLACE(@,LEN(@)-5,6,"" Trce""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Circle"",REPLACE(@,LEN(@)-6,7,"" Cir""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,10)="" Boulevard"",REPLACE(@,LEN(@)-9,10,"" Blvd""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,6)="" Court"",REPLACE(@,LEN(@)-5,6,"" CT""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Street"",REPLACE(@,LEN(@)-6,7,"" St""),@)", "@", rng.Address))
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the UpdateAddressEnd macro.
 
Upvote 0
hiker95 said:
jeffcoleky,

Here is another macro for you to consider that does not do any looping.

Code: 
Sub UpdateAddressEnd()
' hiker95, 03/20/2015, ME843710
Dim lr As Long, rng As Range
Application.ScreenUpdating = False
With Sheets("ListFilter")
  lr = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  Set rng = .Range("M2:V" & lr)
  rng = Evaluate(Replace("IF(RIGHT(@,5)="" Lane"",REPLACE(@,LEN(@)-4,5,"" LN""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,5)="" Road"",REPLACE(@,LEN(@)-4,5,"" RD""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Avenue"",REPLACE(@,LEN(@)-6,7,"" Ave""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,6)="" Trace"",REPLACE(@,LEN(@)-5,6,"" Trce""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Circle"",REPLACE(@,LEN(@)-6,7,"" Cir""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,10)="" Boulevard"",REPLACE(@,LEN(@)-9,10,"" Blvd""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,6)="" Court"",REPLACE(@,LEN(@)-5,6,"" CT""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Street"",REPLACE(@,LEN(@)-6,7,"" St""),@)", "@", rng.Address))
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the UpdateAddressEnd macro.
Click to expand...

That DOES work and I love it! Thank you!

The only problem I have with it on my workbook is that it takes an extensive period of time to run. It makes sense why as I have over 7000 rows. Rows 1-6500, and 6501-7000 have data and are unhidden. The range of hidden and unhidden rows changes daily.

How can I modify it to only run only the rows that are UNHIDDEN? If you can help me with this it would be great, otherwise I can start a new post to ask this question. Either way, thanks!
 
Upvote 0
jeffcoleky,

That DOES work and I love it! Thank you!
Click to expand...

Thanks for the feedback.

You are very welcome. Glad I could help.

The only problem I have with it on my workbook is that it takes an extensive period of time to run.
Click to expand...

Columns M thru V * 7000 rows is 70,000 cells. And, the macro does it work without looping thru the individual cells.

Rows 1-6500, and 6501-7000 have data and are unhidden. The range of hidden and unhidden rows changes daily.
Click to expand...

You did not mention that there were hidden rows.

Are the hidden rows below the 7000 rows, and, grouped together, or, are they mixed hidden + un-hidden?
 
Upvote 0
hiker95 said:
Are the hidden rows below the 7000 rows, and, grouped together, or, are they mixed hidden + un-hidden?
Click to expand...

Rows 3 - ~6500 are all hidden and not mixed. The only visible rows will always be a below the hidden cells (aside from the two header rows).

One more thing that might help speed it up. I only need the macro to work on Columns M and V. Ideally, the columns in between (N, O, P, Q, R, S, T, U) would not be affected by the macro.
 
Upvote 0
jeffcoleky,

Rows 3 - ~6500 are all hidden and not mixed. The only visible rows will always be a below the hidden cells (aside from the two header rows).

One more thing that might help speed it up. I only need the macro to work on columns M and V. Ideally, the columns in between (N, O, P, Q, R, S, T, U) would not be affected by the macro.
Click to expand...

The below macro will work correctly on columns M, and, V only, as long as the last used row in the worksheet is below row 6500.

If the last used row is less then 6501 you will get a message box displaying The last used row is less then 6501 - macro terminated!


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code: 
Sub UpdateAddressEnd_V2()
' hiker95, 03/21/2015, ME843710
Dim lr As Long, rng As Range
With Sheets("ListFilter")
  lr = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  If lr < 6501 Then
    MsgBox ("The last used row is less then 6501 - macro terminated!")
    Exit Sub
  End If
  Application.ScreenUpdating = False
  Set rng = .Range("M6501:M" & lr)
  rng = Evaluate(Replace("IF(RIGHT(@,5)="" Lane"",REPLACE(@,LEN(@)-4,5,"" LN""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,5)="" Road"",REPLACE(@,LEN(@)-4,5,"" RD""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Avenue"",REPLACE(@,LEN(@)-6,7,"" Ave""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,6)="" Trace"",REPLACE(@,LEN(@)-5,6,"" Trce""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Circle"",REPLACE(@,LEN(@)-6,7,"" Cir""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,10)="" Boulevard"",REPLACE(@,LEN(@)-9,10,"" Blvd""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,6)="" Court"",REPLACE(@,LEN(@)-5,6,"" CT""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Street"",REPLACE(@,LEN(@)-6,7,"" St""),@)", "@", rng.Address))
  Set rng = .Range("V6501:V" & lr)
  rng = Evaluate(Replace("IF(RIGHT(@,5)="" Lane"",REPLACE(@,LEN(@)-4,5,"" LN""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,5)="" Road"",REPLACE(@,LEN(@)-4,5,"" RD""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Avenue"",REPLACE(@,LEN(@)-6,7,"" Ave""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,6)="" Trace"",REPLACE(@,LEN(@)-5,6,"" Trce""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Circle"",REPLACE(@,LEN(@)-6,7,"" Cir""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,10)="" Boulevard"",REPLACE(@,LEN(@)-9,10,"" Blvd""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,6)="" Court"",REPLACE(@,LEN(@)-5,6,"" CT""),@)", "@", rng.Address))
  rng = Evaluate(Replace("IF(RIGHT(@,7)="" Street"",REPLACE(@,LEN(@)-6,7,"" St""),@)", "@", rng.Address))
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the UpdateAddressEnd_V2 macro.
 
Upvote 0
It worked! Thanks so much Hiker95! Sorry it took so long to respond. :) Couldn't have done it without you
 
Upvote 0
jeffcoleky,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
VBA to Find and Change Format including partial text
Replies
2
Views
371
rlv01
R
A
  • Question
VBA Highlight cell if contains specific text
Replies
4
Views
169
DanteAmor
DanteAmor
Y
  • Question
Modify Macro to Select 1 .TXT File at a time, do changes on it (tab delimeter+column to text) to convert to .XLS file+save the file then select other
Replies
0
Views
375
yferrer
Y
F
  • Question
Macro Filter question
Replies
0
Views
339
Flora2021
F
J
  • Question
Macro to Search for Comments in Closed Workbooks
Replies
0
Views
459
jkouvel
J

Forum statistics

Threads
1,215,089
Messages
6,123,058
Members
449,091
Latest member
ikke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top