CODEWITHSUNDEEP
vbaexcel
Jeremy Bedsaul
Jeremy Bedsaul

Reputation: 11

Auto-Delete Special characters

I have a spreadsheet where we will be entering phone numbers into column D in the following format: (253) 796-0340. I would like to use a VBA formula/function to automatically remove any parentheses, dashes, or spaces as I paste into a cell in column D. When "Old Value" below is pasted in the cell, it would be replaced automatically with the "New Value"; e.g.:

Old Value: (253) 796-0340

New Value: 2537960340

Some of the users of this spreadsheet are not as Excel savvy. So if there is a way not to have them need to access the source and run the function, that would be great.

Upvotes: 1

Views: 437

Answers (3)

John Smith
John Smith

Reputation: 7407

The general idea you would be trying to do is something like-

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Target.Value = Replace(Replace(Replace(Replace(Target.Value, "(", ""), ")", ""), "-", ""), " ", "")
    Application.EnableEvents = True
End Sub

It is an event that fires every time a value is changed in the worksheet, and removes all unnecessary characters from the value that is entered. Note that this will work on every cell within the worksheet that this code is applied to.

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149287

Another way.

  1. You don't have to loop though all the cells. Imagine a user copying 10000 rows of data. .Replace on the entire column is much faster than looping through every cell.

  2. You can keep adding to MyList = "(|)| |-". All that you want to replace is separated by a |. In case in the future, you want to replace | as well then set a unique delimiter in deLim = "|"

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyList As String, MyAr
    Dim deLim As String
    Dim i As Long

    '~~> Keep Adding whatever you want to replace
    MyList = "(|)| |-"

    deLim = "|"

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns("D:D")) Is Nothing Then
        MyAr = Split(MyList, deLim)

        For i = LBound(MyAr) To UBound(MyAr)
            With Columns("D:D")
                .NumberFormat = "@"
                .Replace What:=MyAr(i), Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
            End With
        Next i
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Upvotes: 0

Gary's Student
Gary's Student

Reputation: 96753

Include the following event macro in the worksheet code area:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim intr As Range, t As String
   Set intr = Intersect(Range("D:D"), Target)
   If intr Is Nothing Then Exit Sub

   Application.EnableEvents = False
   For Each r In intr
      t = Replace(Replace(r.Text, "-", ""), " ", "")
      r.Value = "'" & Replace(Replace(t, ")", ""), "(", "")
   Next r
   Application.EnableEvents = True
End Sub

Because it is worksheet code, it is very easy to install and automatic to use:

  1. right-click the tab name near the bottom of the Excel window
  2. select View Code - this brings up a VBE window
  3. paste the stuff in and close the VBE window

If you have any concerns, first try it on a trial worksheet.

If you save the workbook, the macro will be saved with it. If you are using a version of Excel later then 2003, you must save the file as .xlsm rather than .xlsx

To remove the macro:

  1. bring up the VBE windows as above
  2. clear the code out
  3. close the VBE window

To learn more about macros in general, see:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

and

http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx

To learn more about Event Macros (worksheet code), see:

http://www.mvps.org/dmcritchie/excel/event.htm

Macros must be enabled for this to work!

Upvotes: 1

Related Questions