Leave Only Mobile Numbers & Delete all Text or any Characters in given Range

Prasad K

Board Regular
Joined
Aug 4, 2021
Messages
189
Office Version
  1. 2016
  2. 2007
Platform
  1. Windows
Hi Excel Experts I Need Help in VBA Macro

I have customer data in my excel sheet Column A to Column E & here I found a VBA Code on Google Search to Delete all Text or any Special Character & leave only mobile numbers in a given Range when I run VBA Code

Here what I want in Column B I have Customer Mobile Numbers with Address in Column B I want to delete all text or any character and just leave only 10 digit mobile numbers only in that range Because in my sheet already Customer Address in Column E

When I run this VBA Code in given Range on Column B it’s working perfectly & here what the problem I have getting with this VBA it’s deleting all text or any character in that range what I am expecting & here problem is it’s deleting mobile numbers also like if cell have 2 or 3 mobile numbers then this VBA is Leaving Only 1 Mobile number in that cell and deleting remaining mobile numbers in that range

Here what I want when I run this VBA it’s just delete only text or any character on that range never delete any mobile number


This is Original Data

value function.xlsx
ABCDE
1Customer NameCustomer MobileService B or CService ChargeCustomer Address & City
2Ajay Kumar7412589632 , Ram Nagar, HyderabadC₹ 3,250Ram Nagar , Hyderabad
3Pavan Sekhar6541239874 | 9632587412 , Santhosh Nagar, SecunderabadC₹ 4,120Santhosh Nagar, Secunderabad
4Chandra Kumar2135468793 , Kali Pet Nagar, WarangalB₹ 1,725Kali Pet Nagar, Warangal
5Meenakshi Sharma2587413698 | 3214569874 | 5462139875 , Hanuman Colony, HyderabadC₹ 2,453Hanuman Colony, Hyderabad
6Atul Prasad4172589635 Champak Pet, HyderabadB₹ 1,420Champak Pet, Hyderabad
7Arun Patel3697412581 | 5421789632 , Machili Pet Nagar, WarangalB₹ 1,247Machili Pet Nagar, Warangal
8Sekhar Chandra2476387421 , Asura Nagar, HyderabadC₹ 3,240Asura Nagar, Hyderabad
Sheet2





when i run this VBA it's getting output like this

value function.xlsx
ABCDE
1Customer NameCustomer MobileService B or CService ChargeCustomer Address & City
2Ajay Kumar7412589632C₹ 3,250Ram Nagar , Hyderabad
3Pavan Sekhar6541239874C₹ 4,120Santhosh Nagar, Secunderabad
4Chandra Kumar2135468793B₹ 1,725Kali Pet Nagar, Warangal
5Meenakshi Sharma2587413698C₹ 2,453Hanuman Colony, Hyderabad
6Atul Prasad4172589635B₹ 1,420Champak Pet, Hyderabad
7Arun Patel3697412581B₹ 1,247Machili Pet Nagar, Warangal
8Sekhar Chandra2476387421C₹ 3,240Asura Nagar, Hyderabad
Sheet2





when i run VBA i want to get OutPut Result like this Below


value function.xlsx
ABCDE
1Customer NameCustomer MobileService B or CService ChargeCustomer Address & City
2Ajay Kumar7412589632C₹ 3,250Ram Nagar , Hyderabad
3Pavan Sekhar6541239874|9632587412C₹ 4,120Santhosh Nagar, Secunderabad
4Chandra Kumar2135468793B₹ 1,725Kali Pet Nagar, Warangal
5Meenakshi Sharma2587413698|3214569874|5462139875C₹ 2,453Hanuman Colony, Hyderabad
6Atul Prasad4172589635B₹ 1,420Champak Pet, Hyderabad
7Arun Patel3697412581|5421789632B₹ 1,247Machili Pet Nagar, Warangal
8Sekhar Chandra2476387421C₹ 3,240Asura Nagar, Hyderabad
Sheet2






VBA Code:
Sub OnlyNumber()
Dim s As String
Dim ReturnVal As String
Dim i As Integer
Dim lastRow As Long

ReturnVal = ""
lastRow = Range("B" & Rows.Count).End(xlUp).Row

    For c = 1 To lastRow
        s = Range("B" & c).Value
            For i = 1 To Len(s)
                If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
                ReturnVal = ReturnVal + Mid(s, i, 1)
                End If
            Next i
        If Len(ReturnVal) > 10 And Len(ReturnVal) <= 14 Then
            Range("B" & c).Value = Right(ReturnVal, 10)
            ElseIf Len(ReturnVal) > 14 Then
                Range("B" & c).Value = Left(ReturnVal, 10)
                ElseIf Len(ReturnVal) = 10 Then
                    Range("B" & c).Value = ReturnVal
                    Else
                    MsgBox ("defined number structure")
        End If
        ReturnVal = ""
    Next c
End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Hi again
Try
VBA Code:
Sub test2()
a = Range(Cells(2, 2), Cells(2, 2).End(xlDown))
For I = 1 To UBound(a)
a(I, 1) = Split(a(I, 1), " ,")(0)
Next I
Cells(2, 6).Resize(UBound(a)) = a
End Sub
 
Upvote 0
Hi again
Try
VBA Code:
Sub test2()
a = Range(Cells(2, 2), Cells(2, 2).End(xlDown))
For I = 1 To UBound(a)
a(I, 1) = Split(a(I, 1), " ,")(0)
Next I
Cells(2, 6).Resize(UBound(a)) = a
End Sub
it's spliting mobile numbers and address into column F

value function.xlsx
ABCDEF
1Customer NameCustomer MobileService B or CService ChargeCustomer Address & City
2Ajay Kumar7412589632 , Ram Nagar, HyderabadC₹ 3,250Ram Nagar , Hyderabad7412589632
3Pavan Sekhar6541239874 | 9632587412 , Santhosh Nagar, SecunderabadC₹ 4,120Santhosh Nagar, Secunderabad6541239874 | 9632587412
4Chandra Kumar2135468793 , Kali Pet Nagar, WarangalB₹ 1,725Kali Pet Nagar, Warangal2135468793
5Meenakshi Sharma2587413698 | 3214569874 | 5462139875 , Hanuman Colony, HyderabadC₹ 2,453Hanuman Colony, Hyderabad2587413698 | 3214569874 | 5462139875
6Atul Prasad4172589635 Champak Pet, HyderabadB₹ 1,420Champak Pet, Hyderabad4172589635 Champak Pet, Hyderabad
7Arun Patel3697412581 | 5421789632 , Machili Pet Nagar, WarangalB₹ 1,247Machili Pet Nagar, Warangal3697412581 | 5421789632
8Sekhar Chandra2476387421 , Asura Nagar, HyderabadC₹ 3,240Asura Nagar, Hyderabad2476387421
Sheet2



i need to delete text and character in column B and leave only mobile numbers in column B

how i mention in above query
 
Upvote 0
it's spliting mobile numbers and address into column F

value function.xlsx
ABCDEF
1Customer NameCustomer MobileService B or CService ChargeCustomer Address & City
2Ajay Kumar7412589632 , Ram Nagar, HyderabadC₹ 3,250Ram Nagar , Hyderabad7412589632
3Pavan Sekhar6541239874 | 9632587412 , Santhosh Nagar, SecunderabadC₹ 4,120Santhosh Nagar, Secunderabad6541239874 | 9632587412
4Chandra Kumar2135468793 , Kali Pet Nagar, WarangalB₹ 1,725Kali Pet Nagar, Warangal2135468793
5Meenakshi Sharma2587413698 | 3214569874 | 5462139875 , Hanuman Colony, HyderabadC₹ 2,453Hanuman Colony, Hyderabad2587413698 | 3214569874 | 5462139875
6Atul Prasad4172589635 Champak Pet, HyderabadB₹ 1,420Champak Pet, Hyderabad4172589635 Champak Pet, Hyderabad
7Arun Patel3697412581 | 5421789632 , Machili Pet Nagar, WarangalB₹ 1,247Machili Pet Nagar, Warangal3697412581 | 5421789632
8Sekhar Chandra2476387421 , Asura Nagar, HyderabadC₹ 3,240Asura Nagar, Hyderabad2476387421
Sheet2



i need to delete text and character in column B and leave only mobile numbers in column B

how i mention in above query
Any one solve this
 
Upvote 0
Quick solution using Power Query.

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.SplitColumn(Source, "Customer Mobile", Splitter.SplitTextByEachDelimiter({","}, QuoteStyle.Csv, false), {"Customer Mobile.1", "Customer Mobile.2"}),
    #"Removed Columns" = Table.RemoveColumns(#"Split Column by Delimiter",{"Customer Mobile.2"})
in
    #"Removed Columns"

Book2
ABCDE
1Customer NameCustomer MobileService B or CService ChargeCustomer Address & City
2Ajay Kumar7412589632 , Ram Nagar, HyderabadC3250Ram Nagar , Hyderabad
3Pavan Sekhar6541239874 | 9632587412 , Santhosh Nagar, SecunderabadC4120Santhosh Nagar, Secunderabad
4Chandra Kumar2135468793 , Kali Pet Nagar, WarangalB1725Kali Pet Nagar, Warangal
5Meenakshi Sharma2587413698 | 3214569874 | 5462139875 , Hanuman Colony, HyderabadC2453Hanuman Colony, Hyderabad
6Atul Prasad4172589635 Champak Pet, HyderabadB1420Champak Pet, Hyderabad
7Arun Patel3697412581 | 5421789632 , Machili Pet Nagar, WarangalB1247Machili Pet Nagar, Warangal
8Sekhar Chandra2476387421 , Asura Nagar, HyderabadC3240Asura Nagar, Hyderabad
9
10Customer NameCustomer Mobile.1Service B or CService ChargeCustomer Address & City
11Ajay Kumar7412589632C3250Ram Nagar , Hyderabad
12Pavan Sekhar6541239874 | 9632587412 C4120Santhosh Nagar, Secunderabad
13Chandra Kumar2135468793B1725Kali Pet Nagar, Warangal
14Meenakshi Sharma2587413698 | 3214569874 | 5462139875 C2453Hanuman Colony, Hyderabad
15Atul Prasad4172589635 Champak PetB1420Champak Pet, Hyderabad
16Arun Patel3697412581 | 5421789632 B1247Machili Pet Nagar, Warangal
17Sekhar Chandra2476387421C3240Asura Nagar, Hyderabad
Sheet1
 
Upvote 0
Quick solution using Power Query.

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.SplitColumn(Source, "Customer Mobile", Splitter.SplitTextByEachDelimiter({","}, QuoteStyle.Csv, false), {"Customer Mobile.1", "Customer Mobile.2"}),
    #"Removed Columns" = Table.RemoveColumns(#"Split Column by Delimiter",{"Customer Mobile.2"})
in
    #"Removed Columns"

Book2
ABCDE
1Customer NameCustomer MobileService B or CService ChargeCustomer Address & City
2Ajay Kumar7412589632 , Ram Nagar, HyderabadC3250Ram Nagar , Hyderabad
3Pavan Sekhar6541239874 | 9632587412 , Santhosh Nagar, SecunderabadC4120Santhosh Nagar, Secunderabad
4Chandra Kumar2135468793 , Kali Pet Nagar, WarangalB1725Kali Pet Nagar, Warangal
5Meenakshi Sharma2587413698 | 3214569874 | 5462139875 , Hanuman Colony, HyderabadC2453Hanuman Colony, Hyderabad
6Atul Prasad4172589635 Champak Pet, HyderabadB1420Champak Pet, Hyderabad
7Arun Patel3697412581 | 5421789632 , Machili Pet Nagar, WarangalB1247Machili Pet Nagar, Warangal
8Sekhar Chandra2476387421 , Asura Nagar, HyderabadC3240Asura Nagar, Hyderabad
9
10Customer NameCustomer Mobile.1Service B or CService ChargeCustomer Address & City
11Ajay Kumar7412589632C3250Ram Nagar , Hyderabad
12Pavan Sekhar6541239874 | 9632587412 C4120Santhosh Nagar, Secunderabad
13Chandra Kumar2135468793B1725Kali Pet Nagar, Warangal
14Meenakshi Sharma2587413698 | 3214569874 | 5462139875 C2453Hanuman Colony, Hyderabad
15Atul Prasad4172589635 Champak PetB1420Champak Pet, Hyderabad
16Arun Patel3697412581 | 5421789632 B1247Machili Pet Nagar, Warangal
17Sekhar Chandra2476387421C3240Asura Nagar, Hyderabad
Sheet1
Thankyou sir for reply

I don't know how to apply power query in excel
 
Upvote 0
@ Prasad K
like this
VBA Code:
Sub test()
    a = Range(Cells(2, 2), Cells(2, 2).End(xlDown))
    With CreateObject("VBScript.RegExp")
        .Pattern = " [a-zA-Z]+|\,.[a-zA-Z].+"
        For i = 1 To UBound(a)
            a(i, 1) = .Replace(a(i, 1), "")
        Next
        Cells(2, 2).Resize(UBound(a)) = a
    End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,907
Messages
6,175,301
Members
452,633
Latest member
DougMo

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