Separating one or multiple 5 digit numbers in a text string.

[GuyP16]

Hi All,

New here, first posting. Kinda fun.

I am working with some free text data that includes one of multiple five digit numbers I need to separate out. I have found an equation from here that pulled one code, but not all. Could be up to 8 in one free text set. I am not good with VBA, so would request help running a macro to please.

Thanks in advance,

Guy P

 

[Joe4]

Darn, I was trying to ignore those "number 5" errors and see what the other ones were. Try this variation, which should ignore those blanks and only report those other errors were seeing.

Sub Separating_multiple_5_digit()

    Dim c As Range, cad As String
    Dim n As Variant, d As Variant, i As Long
    Dim errTitle As String, errMsg As String
    
    On Error GoTo err_chk
    For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
        n = Split(Replace(c.Value, ",", " "), " ")
        cad = ""
        For i = 0 To UBound(n)
            d = Val(WorksheetFunction.Trim(n(i)))
            If Len(d) = 5 Then cad = cad & d & ", "
        Next
        If cad <> "" Then
            c.Offset(0, 1).Value = IIf(cad <> "", Left(cad, Len(cad) - 2), cad)
        End If
    Next
    
    MsgBox "End"
    Exit Sub
    
err_chk:
    If Err.Number = 5 Then
        Err.Clear
        Resume Next
    Else
        errTitle = "Error in cell " & c.Address(0, 0)
        errMsg = Err.Number & ": " & Err.Description
        MsgBox errMsg, vbOKOnly, errTitle
    End If
    
End Sub

Same thing, tell us the cell address, value, and error message.

 

[GuyP16]

Joe,
The dialog box that comes up shows an error in A174…the boxisn’t big enough to see the full number, but my guess it’s 17483. The error is showing as “6: Overflow.”

 

[GuyP16]

Just for giggles, I removed that cell and re-ran the macro,it moved on to 18224, a gain of 800 ish. Not sure if that's helpful...

 

[Joe4]

The dialog box that comes up shows an error in A174

Please post the exact contents of cells returnng the errors for me to see (cells A174, A18224).
That is key to figuring out what is going on.

 

[GuyP16]

Joe,

I cannot post exactly the cell content, the originals have privatedata in them, I have substituted numbers and letters to make them generic. Hopefully you can ID the sticking point.

IO 3/26/16 per Stefanie L of Chesterfield Resource, 888-555-3130,no call ref#, auth rq'd and already infile for CPT code 41899, DX K02.9, Sonia, 3/26/18, auth # 19D2058785 has been approved for DOS ;

AR 4/4/17-Called BBBS out of Stat 800-555-2580 and spoke to AngelaR. Auth is requried for CPT code 42820for DX codes R09.81, R06.83, J35. 2, and J03.01 to be done with Dr Goodson on4/16/17 for OP surgery. Auth is donetrhough Chesters Care Management. Call ref is 02222223964200. I was transferred to Chesters Care Management 800- 555-0000and i spoke to Amanda R. Auth was approved for OP surgery with Dr Goodson on 1/16/17. EFCT date is4/4/17 only. If surgery date changes wehave to call chesters care management at 800-305- 4271. Auth num is 18D1444781;

 

[Joe4]

It looks like it was choking on some of the mixed references, like, "19D2058785", so I told it to ignore those errors too.
This seems to work:

Sub Separating_multiple_5_digit()

    Dim c As Range, cad As String
    Dim n As Variant, d As Variant, i As Long
    Dim errTitle As String, errMsg As String
    
    On Error GoTo err_chk
    For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
        n = Split(Replace(c.Value, ",", " "), " ")
        cad = ""
        For i = 0 To UBound(n)
            d = Val(WorksheetFunction.Trim(n(i)))
            If Len(d) = 5 Then cad = cad & d & ", "
        Next
        If cad <> "" Then
            c.Offset(0, 1).Value = IIf(cad <> "", Left(cad, Len(cad) - 2), cad)
        End If
    Next
    
    MsgBox "Finished"
    Exit Sub
    
err_chk:
    Select Case Err.Number
        Case 5, 6
            'ignore error numbers 5 and 6
            Err.Clear
            Resume Next
        Case Else
            'Other errors
            errTitle = "Error in cell " & c.Address(0, 0)
            errMsg = Err.Number & ": " & Err.Description
            MsgBox errMsg, vbOKOnly, errTitle
    End Select
    
End Sub

 

[DanteAmor]

You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[GuyP16]

Dante/Joe,

Thank you both very much. I now have 29190 cells with CPT codes separated from the free text.

All the best,

Guy

 

[DanteAmor]

You're welcome. Thanks for the feedback.

 

[GuyP16]

Joe/Dante,



Just working through the analysis I have to do on this data andhave realized that in the free text there are many instances of the same 5digit code appearing twice or more. Would you mind adding some coding to remove duplicates please?



For example,



“1/9/19 - Mt Smith booked code 12345, 12346 and 12349. Called to get auth. 1/15/19 – Received auth for 12345 and 12346,12349 was denied.”



This currently results in the output column having the followingresult:

12345, 12346, 12349, 12345, 12346, 12349.

What I need this to do is:
12345, 12346, 12349
The duplicates having been removed




Thank you both again!


Guy