Extracting numbers with spaces from excel using VBA

Question

Need to extract numbers from the following text with spaces between numbers using VBA, possibly.

Units : 1.00, Code: '99213', M1: '25',Comments: 'Records do not include documentation of an evaluation and management service that is separately identifiable from the service also performed on 01/12/2018. Therefore the modifier 25 for 99213 is not supported.'

Current VBA extracts the numbers but puts in this format:

10099213125011220182599213 which is including dates - don't need.

Would like to see:

100 99213 25.

Here is my current code:

Function OnlyNums(strWord As String) As String
    Dim strChar As String
    Dim x As Integer
    Dim strTemp As String
    strTemp = ""
    Application.ScreenUpdating = False
    For x = 1 To Len(strWord)
        strChar = Mid(strWord, x, 1)
        If Asc(strChar) >= 48 And _
          Asc(strChar) <= 57 Then
            strTemp = strTemp & strChar
        End If
    Next
    Application.ScreenUpdating = True
    OnlyNums = "'" & strTemp & "'"
End Function

score 0 · Answer 1 · answered May 01 '18 at 17:13

0

This appears to work:

Function OnlyNums(strWord As String) As String
    Dim s As String
    s = Replace(strWord, ",", " ")
    s = Replace(s, ".", "")
    s = Replace(s, "'", " ")
    s = Application.WorksheetFunction.Trim(s)
    ary = Split(s, " ")
    OnlyNums = ""
    For Each a In ary
        If IsNumeric(a) Then OnlyNums = OnlyNums & " " & a
    Next a
End Function

The only tricky part was discarding the decimal point, and cleaning up some other special characters.

answered May 01 '18 at 17:13

Gary's Student

19,396

One other item - within the code - if I had something within single quotes such as 'C1714' in addition to '99213' is there a way to extract the C? Thank you for the help. – Ryan Red May 02 '18 at 15:57

score 0 · Answer 2 · answered May 01 '18 at 17:33

Another option

Option Explicit

Public Function OnlyNums(ByVal txt As String) As String

    Dim arr As Variant, itm As Variant, unit As Variant
    Dim i As Long, ltr As String, ascLtr As Long, nums As String

    txt = Left(txt, InStr(1, txt, ",Comments:")) 'extract just the part before "Comments"

    arr = Split(txt, ",")

    For Each itm In arr
        itm = Trim$(itm)
        If InStr(1, itm, ":") > 0 Then unit = Split(itm, ":")(1) Else unit = itm
        For i = 1 To Len(unit)
            ltr = Mid(unit, i, 1)
            ascLtr = Asc(ltr)
            If ascLtr >= 48 And ascLtr <= 57 Then nums = nums & ltr
        Next
        nums = nums & " "
    Next
    OnlyNums = "'" & Trim$(nums) & "'"
End Function

Extracting numbers with spaces from excel using VBA

2 Answers2