Consulting

Results 1 to 7 of 7

Thread: how to add range in this vba code

  1. #1
    VBAX Regular
    Joined
    Sep 2021
    Location
    INDIA
    Posts
    14
    Location

    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


    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
    Last edited by prasadk; 12-05-2021 at 09:58 AM.

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,476
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Regular
    Joined
    Sep 2021
    Location
    INDIA
    Posts
    14
    Location
    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

  4. #4
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    620
    Location
    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
    I was not told it was impossible, so i did it.

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,476
    Quote Originally Posted by prasadk View Post
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    VBAX Regular
    Joined
    Sep 2021
    Location
    INDIA
    Posts
    14
    Location
    Thank you so much p45cal it's working perfectly as i am expected

  7. #7
    VBAX Regular
    Joined
    Sep 2021
    Location
    INDIA
    Posts
    14
    Location
    Thank you very much georgiboy
    i have tested your code it's working perfectly

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •