Extract numeric value from a cell

[Nelson78]

Hello everybody.


I've a problem about one of my Excel works that I'm trying to solve unsuccessfully.

There are two columns (F and G) populated by phone numbers. Unfortunately, these phone numbers are "alterated" by alphabetic characters, spaces (" ") or special characters ("/", "_", ecc).

Example of "altereted" numbers:
335 1234567
336/1234567
TEL3371234567
I need to extract numeric characters and rewriting on the same cell with a vba code.

Example of correct numbers.
3351234567
3361234567
3371234567

Seep into consideration that the operation must be repeted from row 2 until column F is populated.
Something like:
LR = Cells(Rows.Count, "F").End(xlUp).Row
For Each Cell In Range("F2:G" & LR)



Thank you in advance for your help.


Nelson78

 

[Kenneth Hobson]

You can easily test your pattern. There are many patterns other there for telephone numbers depending on your country.

Another approach would be an If, Left, and Len routine. e.g.

Sub Main()
  Dim s
  's = "TEL33712345678"         '3371234567
  's = "TEL3371234567"          '3371234567
  s = "TEL1371234567891011"     '1371234567891011
  
  With CreateObject("VBScript.RegExp")
    .Pattern = "\D"
    .Global = True
    s = .Replace(s, "")
    If Left(s, 1) = 3 Then
      If Len(s) > 10 Then s = Left(s, 10)
    End If
    Debug.Print s
  End With
End Sub

 

[Nelson78]

I'm testing the following one. For the moment is ok.


Sub main()
Columns("F:G").NumberFormat = "@"
LR = Cells(Rows.Count, "F").End(xlUp).Row
For Each cell In Range("F2:G" & LR)
If Left(cell.Value, 1) = "3" Then
If Len(cell) > 10 Then cell.Value = Left(cell, 10)
End If
Next
End Sub

 

[Nelson78]

With this stuff now I've a new hitch.

Two other columns, not adjacent to the first couple, have to be involved in the process.


So, for setting the columns as text, the following expression could be ok:

 Range("F:G,M:N").Select
    Selection.NumberFormat = "@"

But how can I expand the process to M and N column?

For Each cell In Range("F2:G" & LR)

 

[Kenneth Hobson]

Sub Test()
  Dim r As Range, c As Range, LR As Long
  LR = 3
  Set r = Range("F2:G" & LR & ",M2:N" & LR)
  With r
    .NumberFormat = "General"
    .Formula = "=Row() & "" "" & Column()"
    For Each c In r
      Debug.Print c.Value
    Next c
  End With
End Sub

 

[Nelson78]

Works.

Thank you.