Seperate all contact valid numbers from cluttered text in Excel through VBA

[gokuleshdasa]

I am a manager in an NGO and deal with hell lots of Excel files. I am struggling with this problem for the past 6 years and did not get any proper solution but manual "text to columns splitter" & find-replace functions, etc.

I humbly request experts here to help me. It will be useful for many people like me.

Okay so going straight, I get data always from different people and it is in this format:

91 80 40931584(R) 9980099607(M) -
999999999999999(M) - this is not valid. **Remove**
91 - 9886033006 91-080-9886033006
0877 3120132 91-0877-2241056
0986002107291-- remove as this is beyond 10 digit.
+919380519217 +91-44-2447 5200
+919380519217
+91-44-2447 5200

In the case of landline nos., 91 is country code and 80 is city code (which can be 2-4 digits) and after that 7 digit (40931584) is telephone no. If any occurrence VBA finds, then it should produce result like: 08040931584 removing all 91s.

In the case of mobile nos., mobiles will start from 7/8/9, e.g. 9980099607 and they will be strictly 10 digits. AI should remove all +91s and sometimes 91 (no plus). This creates so much confusion.

I want some VBA Script which works with artificial intelligence (I mean some logic) and understands all mobile numbers and landline numbers and clears them and distributes them in new columns if need be. If its only 1 number leave it there only.

Final result I am expecting should be:

08040931584 9980099607
9886033006 9886033006 (91-080-removed because it is a mobile and doesnt require city and country code)
08773120132 08772241056
9380519217 04424475200
9380519217
04424475200

You will really save my life. I will pray for you!!!

The subscriber phone numbers are 6, 7 or 8-digit long depending upon the length of the STD code. STD codes are either 4, 3 or 2 digits.

- When the area code is 2-digit, the phone number is 8-digit (2+8)
- When the area code is 3-digit, the phone number is 7-digit (3+7)
- When the area code is 4-digit, the phone number is 6-digit (4+6)

For example, all metropolitan cities have a 2-digit area/STD code and an 8-digit phone number. At present, 2-digit STD codes (also known as area or trunk codes) are 11, 20, 22, 33, 40, 44, 79, 80.

First digit in subscriber number will not be 0, 1, 7, 8 and 9.

 

[Fluff]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Seperate Landline and Mobile numbers from cluttered text through VBA
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[nemmi69]

Sub zz()
Dim WbName As Workbook
Dim WsName1 As Worksheet
Dim AreaCode()
Dim CtryCode()
Dim LastRow As Long
Dim RString As String
Dim TStr As String
Dim TLoop As Long
Dim ALoop As Long
Dim AC As Boolean
Dim CC As Boolean

Set WbName = ThisWorkbook
Windows(ThisWorkbook.Name).Activate
Set WsName1 = WbName.Sheets(1)

LastRow = WsName1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
CtryCode() = Array("91")
AreaCode = Array("11", "20", "22", "33", "40", "44", "79", "80")

For TLoop = 1 To LastRow
    RString = WsName1.Range("A" & TLoop).Value
    ' remove + sign
    If Left(tstring, 1) = "+" Then
        RString = Trim(Right(RString, Len(tsring) - 1))
    End If
    ' Extract country code
    CC = False
    TStr = ""
    For ALoop = LBound(CtryCode) To UBound(CtryCode)
        If Left(RString, 2) = CtryCode(ALoop) Then
            CC = True
            TStr = Left(RString, 2)
            If InStr(1, RString, "-") > 0 And InStr(1, RString, "-") <= 4 Then
                RString = Trim(Right(RString, Len(RString) - InStr(1, RString, "-")))
            ElseIf InStr(1, RString, " ") > 0 And InStr(1, RString, " ") <= 3 Then
                RString = Trim(Right(RString, Len(RString) - InStr(1, RString, " ")))
            End If
            Exit For
        End If
    Next ALoop
    If CC = True Then
        WsName1.Range("C" & TLoop).Value = TStr
    End If
    ' Extract known area code
    AC = False
    TStr = ""
    For ALoop = LBound(AreaCode) To UBound(AreaCode)
        If Left(RString, 2) = AreaCode(ALoop) Then
            AC = True
            TStr = Left(RString, 2)
            If InStr(1, RString, " ") > 0 And InStr(1, RString, "-") <= 4 Then
                RString = Trim(Right(RString, Len(RString) - InStr(1, RString, "-")))
            ElseIf InStr(1, RString, " ") > 0 And InStr(1, RString, " ") <= 3 Then
                RString = Trim(Right(RString, Len(RString) - InStr(1, RString, " ")))
            End If
            Exit For
        End If
    Next ALoop
    If AC = True Then
        WsName1.Range("D" & TLoop).Value = TStr
        WsName1.Range("E" & TLoop).Value = Left(RString, 8)
    Else
        WsName1.Range("E" & TLoop).Value = RString & " (X)"
    End If
    
Next TLoop
End Sub

Produces the following (X) indicates invalid

 

[nemmi69]

Improved

Sub zz()
Dim WbName As Workbook
Dim WsName1 As Worksheet
Dim AreaCode()
Dim CtryCode()
Dim LastRow As Long
Dim RString As String
Dim TStr As String
Dim TLoop As Long
Dim ALoop As Long
Dim AC As Boolean
Dim CC As Boolean

Set WbName = ThisWorkbook
Windows(ThisWorkbook.Name).Activate
Set WsName1 = WbName.Sheets(1)

LastRow = WsName1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
CtryCode() = Array("91")
AreaCode = Array("11", "20", "22", "33", "40", "44", "79", "80")

For TLoop = 1 To LastRow
    RString = Trim(WsName1.Range("A" & TLoop).Value)
    ' remove + sign
    If Left(RString, 1) = "+" Then
        RString = Trim(Right(RString, Len(RString) - 1))
    End If
    ' Extract country code
    CC = False
    TStr = ""
    For ALoop = LBound(CtryCode) To UBound(CtryCode)
        If Left(RString, 2) = CtryCode(ALoop) Then
            CC = True
            TStr = Left(RString, 2)
            If InStr(1, RString, "-") > 0 And InStr(1, RString, "-") <= 4 Then
                RString = Trim(Right(RString, Len(RString) - InStr(1, RString, "-")))
            ElseIf InStr(1, RString, " ") > 0 And InStr(1, RString, " ") <= 3 Then
                RString = Trim(Right(RString, Len(RString) - InStr(1, RString, " ")))
            Else
                RString = Trim(Right(RString, Len(RString) - 2))
            End If
            Exit For
        End If
    Next ALoop
    If CC = True Then
        WsName1.Range("C" & TLoop).Value = TStr
    End If
    ' Extract known area code
    AC = False
    TStr = ""
    For ALoop = LBound(AreaCode) To UBound(AreaCode)
        If Left(RString, 2) = AreaCode(ALoop) Then
            AC = True
            TStr = Left(RString, 2)
            If InStr(1, RString, " ") > 0 And InStr(1, RString, "-") <= 4 Then
                RString = Trim(Right(RString, Len(RString) - InStr(1, RString, "-")))
            ElseIf InStr(1, RString, " ") > 0 And InStr(1, RString, " ") <= 3 Then
                RString = Trim(Right(RString, Len(RString) - InStr(1, RString, " ")))
            Else
                RString = Trim(Right(RString, Len(RString) - 2))
            End If
            Exit For
        End If
    Next ALoop
    If AC = True Then
        WsName1.Range("D" & TLoop).Value = TStr
        WsName1.Range("E" & TLoop).Value = Left(RString, 8)
    Else
        WsName1.Range("E" & TLoop).Value = RString & " (X)"
    End If
    
Next TLoop
End Sub