how to add range in this vba code

[prasadk]

how to add range in this vba code

like how to add column B range in this code by removing the selection





Sub RemoveNon()

For Each r In Selection
vout = ""
v = r.Text
n = Len(v)
For i = 1 To n
ch = Mid(v, i, 1)
If ch Like "[0-9]" Then
vout = vout & ch
ElseIf ch Like "|" Then
vout = vout & ch
End If
Next i
r.Value = vout
Next r
End Sub

[p45cal]

Sub RemoveNonAlphaNum()
For Each r In Intersect(ActiveSheet.UsedRange, Columns("B"))
vout = ""
v = r.Text
n = Len(v)
For i = 1 To n
ch = Mid(v, i, 1)
If ch Like "[0-9]" Or ch Like "|" Then vout = vout & ch
Next i
r.Value = vout
Next r
End Sub

[prasadk]

Hi p45cal it's working perfectly Thank you so much

here i want some small change in this code again in my sheet i have heading in Column B with (Customer Mobile Number)

in my sheet i have 10 digit mobile numbers data start from Column B2 to entire B Range & here when i run this code it's deleting all text or any characters in Column B Range & Leaving only 10 digit Mobile Numbers it's done perfectly

here problem is it's deleting heading also of Customer Mobile Number kindly please change this code to avoid heading when i run this vba

[georgiboy]

One method might be to edit:

Intersect(ActiveSheet.UsedRange, Columns("B"))
With:

Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))

Or another method completely if running on large amounts of data might be:

Sub RegexMethod()
Dim rng As Range, values As Variant
Dim r As Long, c As Long, i As Long

Set rng = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
values = rng.Value

With New RegExp
.Pattern = "[^0-9|]"
.MultiLine = True
.Global = True
For r = LBound(values, 1) To UBound(values, 1)
For c = LBound(values, 2) To UBound(values, 2)
values(r, c) = .Replace(values(r, c), vbNullString)
Next
Next
End With
rng = values
End Sub

The above will need a reference added called: 'Microsoft VBScript Regular Expressions 5.5'

Hope this helps

[p45cal]

it's deleting heading also of Customer Mobile Number kindly please change this code to avoid heading when i run this vba
Sub RemoveNonAlphaNum()
Set Rng = Intersect(ActiveSheet.UsedRange, Columns("B"))
For Each r In Intersect(Rng, Rng.Offset(1)) 'this will fail if you have something in the bottommost row of the entire sheet.
vout = ""
v = r.Text
n = Len(v)
For i = 1 To n
ch = Mid(v, i, 1)
If ch Like "[0-9]" Or ch Like "|" Then vout = vout & ch
Next i
r.Value = vout
Next r
End Sub

[prasadk]

Thank you so much p45cal it's working perfectly as i am expected

[prasadk]

Thank you very much georgiboy
i have tested your code it's working perfectly