Extract Digits (Remove Alphabets) from Selected Range

    Public Function ExtractDigits(ByVal cell As String) As Object
        'This function will extract 1st continuous set of digits.
        Dim i As Long, flag As Long
        flag = 0
        ExtractDigits = ""
        For i = 1 To Len(cell)
            If Mid(cell, i, 1) >= "0" And _
               Mid(cell, i, 1) <= "9" Then
                flag = 1
                ExtractDigits = ExtractDigits & Mid(cell, i, 1)
                ExtractDigits = ExtractDigits * 1
            Else
                If flag = 1 Then Exit Function
            End If
        Next i
    End Function

    Sub Extract_Digits()
        ' This module will extract digits from selected range of cells using above User-defined function.         Dim MyCell As Range
        Dim tmpCol As Integer
        Dim flag As Boolean
        tmpCol = Selection.Column
        For Each MyCell In Selection.Cells
                MyCell.Value = ExtractDigits(MyCell.Value)
        Next
        MyCell = Nothing
    End Sub

Comments