VBA to Remove Punctuation and spaces

R

Rodney Jorgensen

Active Member
Joined
Nov 9, 2007
Messages
411
I need VBA to remove all punctuation and spaces from cells. What I want is to do this from the same columns every spreadhseet that I open and when it gets to row 700 to stop. So I guess a range for this example could be A1:B700.

Thanks for your help!

Rodney Jorgensen
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
Hi Rodney

Can you please be specific about what characters to keep or to remove?

Like:

- keep letters, numbers, underscores and hyphens

or

- delete ? ! ; , . : " ' spaces linebreaks
 
Upvote 0
You probably want to loop removing characters not between ansi 65 and 96. I'll try to make something.
 
Upvote 0
I actually came up with this and it does work. The code is at the bottom. I do however have a problem with this code. It appears that when replacing the abbriviations with the first part of the code, it is not beginning to look from the left most character in the cell. It appears that it is only replacing the abbriviations at the end of the cell.

I have a suspicion that this is the offending code, but I have no clue how to adjust it.

get_word = Mid(.Substitute(text_string, " ", "^", Len(text_string) - _
Len(.Substitute(text_string, " ", ""))), .Find("^", .Substitute(text_string, " ", "^", _
Len(text_string) - Len(.Substitute(text_string, " ", "")))) + 1, 256)

Complete VBA Code

Sub test()
On Error Resume Next
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
With Application.WorksheetFunction
text_string = Range("A" & i).Value
get_word = Mid(.Substitute(text_string, " ", "^", Len(text_string) - _
Len(.Substitute(text_string, " ", ""))), .Find("^", .Substitute(text_string, " ", "^", _
Len(text_string) - Len(.Substitute(text_string, " ", "")))) + 1, 256)

Select Case get_word
Case "AVE"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "AVE", "AVENUE")
Case "BLVD"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "BLVD", "BOULEVARD")
Case "BVD"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "BVD", "BOULEVARD")
Case "CYN"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "CYN", "CANYON")
Case "CTR"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "CTR", "CENTER")
Case "CIR"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "CIR", "CIRCLE")
Case "CT"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "CT", "COURT")
Case "DR"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "DR", "DRIVE")
Case "FWY"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "FWY", "FREEWAY")
Case "HBR"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "HBR", "HARBOR")
Case "HTS"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "HTS", "HEIGHTS")
Case "HWY"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "HWY", "HIGHWAY")
Case "JCT"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "JCT", "JUNCTION")
Case "LN"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "LN", "LANE")
Case "MTN"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "MTN", "MOUNTAIN")
Case "PKWY"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "PKWY", "PARKWAY")
Case "PL"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "PL", "PLACE")
Case "PLZ"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "PLZ", "PLAZA")
Case "RDG"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "RDG", "RIDGE")
Case "RD"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "RD", "ROAD")
Case "RTE"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "RTE", "ROUTE")
Case "ST"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "ST", "STREET")
Case "TRWY"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "TRWY", "THROUGHWAY")
Case "TRL"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "TRL", "TRAIL")
Case "TPKE"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "TPKE", "TURNPIKE")
Case "VLY"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "VLY", "VALEY")
Case "VLG"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "VLG", "VILLAGE")
Case "APT"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "APT", "APARTMENT")
Case "APTS"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "APTS", "APARTMENTS")
Case "BLDG"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "BLDG", "BUILDING")
Case "FL"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "FLR", "FLOOR")
Case "OFC"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "OFC", "OFFICE")
Case "OF"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "OF", "OFFICE")
Case "STE"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "STE", "SUITE")
Case "N"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "N", "NORTH")
Case "E"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "E", "EAST")
Case "S"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "S", "SOUTH")
Case "W"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "W", "WEST")
Case "NE"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "NE", "NORTHEAST")
Case "SE"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "SE", "SOUTHEAST")
Case "SW"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "SW", "SOUTHWEST")
Case "NW"
Range("A" & i).Value = .Substitute(Range("A" & i).Value, "NW", "NOTHWEST")

End Select

End With
Next i
Dim c As Range

For Each c In Selection.Cells
c = Replace(c, "!", "")
c = Replace(c, "@", "")
c = Replace(c, "#", "")
c = Replace(c, "$", "")
c = Replace(c, "%", "")
c = Replace(c, "^", "")
c = Replace(c, "&", "")
c = Replace(c, "*", "")
c = Replace(c, "(", "")
c = Replace(c, ")", "")
c = Replace(c, "_", "")
c = Replace(c, "-", "")
c = Replace(c, "+", "")
c = Replace(c, "=", "")
c = Replace(c, "{", "")
c = Replace(c, "[", "")
c = Replace(c, "}", "")
c = Replace(c, "]", "")
c = Replace(c, "|", "")
c = Replace(c, "\", "")
c = Replace(c, ";", "")
c = Replace(c, ":", "")
c = Replace(c, "'", "")
c = Replace(c, ",", "")
c = Replace(c, "<", "")
c = Replace(c, ".", "")
c = Replace(c, "/", "")
c = Replace(c, "?", "")
c = Replace(c, "`", "")
c = Replace(c, "~", "")
c = Replace(c, " ", "")
Next
End Sub
 
Upvote 0
You shouldn't need to use the worksheet function SUBSTITUTE at all, you could use Replace as you did in the second part.

In the second part, why are you using Selection and not a defined range as in the first part? You are also specifying a lot of different punctuation, is there punctuation that you wish to keep or just get rid of all punctuation?
 
Upvote 0
I am almost there!

The Replace function for the Address Abbriviations does not work the way I need it to. It does not take into account that the abbrieviation needs to be it own separate word.

Example: When just the replace macro is run with the abbriviations 10101 Southern Boulevard becomes 10101 Southern Boulevaroad.

It is seeing the RD in BLOULEVARD and repacling it with ROAD, which I do not want. It needs to be its own separate abbriviation.

What I am working to accomplish is check street addresses between 2 different sources. One Source is User entered into the Database while the other is is uploaded via spreadsheet. There are limitations to the user entered database, so Abbriviations are commonly used as well as removing punctuation to make the address fit.

I am comparing the user DB against the Spreadsheet DB to look for errors. I do not care about abbriviations and punctuation between the 2 as it is the same address. What I am looking for is that the addresses are indeed different. I am creating this macro to remove all abbriviations all punctuation and spaces from both DB's and using an EXACT formula to check and see if the 2 entries match. This will take away all the "Mismatches" due to abbriviations, punctuation and the user limitations from the user DB.

How can I change the SUBSTITUTE part of the VBA code to make it work? Also, Since Drive could be abbriviated DR or DR., would the VBA catch the DR. as an abbriviation and make that change? If not I would need to remove all the punctuation, then the abbriviations, then last the spaces.

Thanks so much for your help.
 
Upvote 0
Code: 
The Replace function for the Address Abbriviations does not work the way I need it to. It does not take into account that the abbrieviation needs to be it own separate word.

This can be dealt with. Will have some code for you in a bit.
 
Upvote 0
Code: 
Sub test()
Dim c As Range, t As String
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    t = UCase(" " & RemovePunctuation(c.Text) & " ")
    t = Replace(t, " AVE ", " AVENUE ")
    t = Replace(t, " BLVD ", " BOULEVARD ")
    t = Replace(t, " BVD ", " BOULEVARD ")
    t = Replace(t, " CYN ", " CANYON ")
    t = Replace(t, " CTR ", " CENTER ")
    t = Replace(t, " CIR ", " CIRCLE ")
    t = Replace(t, " CT ", " COURT ")
    t = Replace(t, " DR ", " DRIVE ")
    t = Replace(t, " FWY ", " FREEWAY ")
    t = Replace(t, " HBR ", " HARBOR ")
    t = Replace(t, " HTS ", " HEIGHTS ")
    t = Replace(t, " HWY ", " HIGHWAY ")
    t = Replace(t, " JCT ", " JUNCTION ")
    t = Replace(t, " LN ", " LANE ")
    t = Replace(t, " MTN ", " MOUNTAIN ")
    t = Replace(t, " PKWY ", " PARKWAY ")
    t = Replace(t, " PL ", " PLACE ")
    t = Replace(t, " PLZ ", " PLAZA ")
    t = Replace(t, " RDG ", " RIDGE ")
    t = Replace(t, " RD ", " ROAD ")
    t = Replace(t, " RTE ", " ROUTE ")
    t = Replace(t, " ST ", " STREET ")
    t = Replace(t, " TRWY ", " THROUGHWAY ")
    t = Replace(t, " TL ", " TRAIL ")
    t = Replace(t, " TPKE ", " TURNPIKE ")
    t = Replace(t, " VLY ", " VALLEY ")
    t = Replace(t, " VLG ", " VILLAGE ")
    t = Replace(t, " APT ", " APARTMENT ")
    t = Replace(t, " APTS ", " APARTMENTS ")
    t = Replace(t, " BLDG ", " BUILDING ")
    t = Replace(t, " FLR ", " FLOOR ")
    t = Replace(t, " OFC ", " OFFICE ")
    t = Replace(t, " OF ", " OFFICE ")
    t = Replace(t, " APT ", " APARTMENT ")
    t = Replace(t, " STE ", " SUITE ")
    t = Replace(t, " N ", " NORTH ")
    t = Replace(t, " E ", " EAST ")
    t = Replace(t, " S ", " SOUTH ")
    t = Replace(t, " W ", " WEST ")
    t = Replace(t, " NE ", " NORTHEAST ")
    t = Replace(t, " SE ", " SOUTHEAST ")
    t = Replace(t, " SW ", " SOUTHWEST ")
    t = Replace(t, " NW ", " NORTHWEST ")
    c = Trim(t)
Next
End Sub


Function RemovePunctuation(r As String) As String
With CreateObject("vbscript.regexp")
    .Pattern = "[^A-Z0-9 ]"
    .IgnoreCase = True
    .Global = True
    RemovePunctuation = .Replace(r, "")
End With
End Function
 
Upvote 0
Thanks for the code. It looks like it does all that I need except removing the spaces in the cell. I hope that this could be added. Also, I will need this to be in a range of 4 columns of data. For this purpose lets use Columns A, B, C & D. When I get it into my final production it will be columns at the end of the spreadsheet, but I should be able to figure out how to change the range once you have it set here for this example.

I really hope the spaces can be trimmed also to use an exact match.

Thanks
Rodney Jorgensen
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
VBA Function to remove line spaces in an Email
Replies
2
Views
165
Ragham26
R
S
  • Question Question
VBA support : need to remove extra space
Replies
2
Views
332
sksanjeev786
S
J
  • Question Question
Copy Picture - VBA
2
Replies
10
Views
271
Logit
Logit
B
  • Question Question
Remove Duplicates from previous or multiple sheets.
Replies
7
Views
319
Benji3899
B
B
  • Question Question
Removed Feature: Pivot Table
Replies
0
Views
195
bec98
B

Forum statistics

Threads
1,224,817
Messages
6,181,149
Members
453,021
Latest member
Justyna P

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