Cant get regex to replace characters

[vba317]

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.

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

 

[wideboydixon]

I think you might be able to use the power of regular expressions:

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

 

[vba317]

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, [TABLE="width: 161"]
<tbody>[TR]
[TD="class: xl64, width: 161"](978) -000-0000,
(978) 000- 0000
(978) 000- 0000

Once again thank you for any help.



[/TD]
[/TR]
</tbody>[/TABLE]