how to add range in this vba code

how to add range in this vba code

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

Code:

---


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

---

Code:

---

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

---

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

One method might be to edit:

Code:

---

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

---

With:

Code:

---

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

---

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

Code:

---

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

Quote:

---

Originally Posted by prasadk

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

---

Code:

---

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

---

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

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