Cant get regex to replace characters

vba317

Board Regular
Joined
Oct 7, 2015
Messages
58
I am trying to clean a file with phone numbers that have put in incorrect. I have fixed many issues, text after the phone number, missing parentheses, etc. I am trying to use regex to look for a missing space after the closing parentheses ex. (978)882
What I need the code to do is add a space after the closing parentheses so the result would be (978) 882. I am not getting any errors but the phone number is not being changed.
Any help is appreciated.

Code:
Public Sub CleanPhoneNumbers()
Dim rgxRegExp As Object
Dim rngCell As Range
Dim rngRange As Range
Dim wrkbk As Excel.Workbook
Dim wrkSh As Excel.Worksheet
Dim llastRow As Long
Dim x As Long
Dim sName As String
Dim sCol As String


     Set wrkbk = ActiveWorkbook
     Set wrkSh = wrkbk.Worksheets("Data")
     llastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    For x = 1 To 3
        If x = 1 Then sName = "HomePhone"
        If x = 2 Then sName = "WorkPhone"
        If x = 3 Then sName = "MobilePhone"
        Call FindColumnName(sName, sCol)
        Stop
        Set rngRange = wrkSh.Range(sCol & "2:" & sCol & llastRow)
        Set rgxRegExp = CreateObject("VBScript.RegExp")
        rgxRegExp.Global = True


        With Application
            .Calculation = xlCalculationManual
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        For Each rngCell In rngRange.SpecialCells(xlCellTypeConstants)
                'Remove all letters from the phone Number
                rgxRegExp.Pattern = "[a-zA-Z]"
            rngCell.Value = rgxRegExp.Replace(rngCell.Value, vbNullString)
'            If rngCell.Value = "(978) 682-9758" Then Stop
            If Left(rngCell.Value, 4) = "978-" Then rngCell.Value = Replace(rngCell.Value, "978-", "(978) ")
            If Left(rngCell.Value, 4) = "978 " Then rngCell.Value = Replace(rngCell.Value, "978 ", "(978) ")
'            If Left(rngCell.Value, 6) = "(978)8" Then rngCell.Value = Replace(rngCell.Value, "(978)8 ", "(978) 8")
            If Mid(rngCell.Value, 10, 1) = " " Then rngCell.Value = Replace(rngCell.Value, " ", "-")
            If Left(rngCell.Value, 5) = "(000)" Then rngCell.ClearContents
            If Left(rngCell.Value, 4) = "-603" Then rngCell.ClearContents
            If Left(rngCell.Value, 7) = "(978) -" Then rngCell.Value = Replace(rngCell.Value, "(978) -", "(978) ")
            If Left(rngCell.Value, 6) = "(978)-" Then rngCell.Value = Replace(rngCell.Value, "(978)-", "(978) ")
            If Left(rngCell.Value, 7) = "(978)  " Then rngCell.Value = Replace(rngCell.Value, "(978)  ", "(978) ")
            If Mid(rngCell.Value, 7, 3) = "000" Then rngCell.ClearContents
            If Mid(rngCell.Value, 10, 2) = "- " Then rngCell.Value = Replace(rngCell.Value, "- ", "-")
            If Mid(rngCell.Value, 1, 4) = "603-" Then rngCell.Value = Replace(rngCell.Value, "603-", "(603) ")
            If Mid(rngCell.Value, 10, 2) = "--" Then rngCell.Value = Replace(rngCell.Value, "--", "-")
            If Mid(rngCell.Value, 4, 1) = "- " Then rngCell.Value = Replace(rngCell.Value, "- ", "-")
            If Mid(rngCell.Value, 6, 1) <> " " Then rngCell.Value = Format(rngCell.Value, "(000) 000-0000")
            'Check for no space after )
              If rngCell.Value = "(978) 973-6026" Then Stop
         If Mid(rngCell.Value, 6, 1) <> " " Then
            rgxRegExp.Pattern = "\)0-9 "
            rngCell.Value = rgxRegExp.Replace(rngCell.Value, ") ")
         End If
        Next
        With Application
            .Calculation = xlCalculationAuto
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Stop
    Next x
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
I think you might be able to use the power of regular expressions:

Code:
Dim rgxMatches As Object
...
...
            rgxRegExp.Pattern = "\(?(\d{3})\)?[\s.-]?(\d{3})[\s.-]?(\d{4})"
            Set rgxMatches = rgxRegExp.Execute(rngCell.Value)
            If rgxMatches.Count > 0 Then
                rngCell.Value = "(" & rgxMatches.Item(0).SubMatches(0) & ") " & rgxMatches.Item(0).SubMatches(1) & "-" & rgxMatches.Item(0).SubMatches(2)
            End If

The regular expression uses capture groups to find 3 groups of numbers (3, 3 and 4) and then uses the captured groups to change the cell value. Give it a whirl and see how it works for you.

WBD
 
Upvote 0
This code did fix the issue I was asking about so thank you! I should have stated in the beginning that this is a free text field instead of a phone number field. I now have the following issues of dashes in the wrong spot and extra spaces
ex.
(978) -68-0-0000,
(978) -000-0000,
(978) 000- 0000
(978) 000- 0000

Once again thank you for any help.




<tbody>
</tbody>
 
Upvote 0

Forum statistics

Threads
1,215,235
Messages
6,123,784
Members
449,124
Latest member
shreyash11

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