Text to columns vba

austlee

New Member
Joined
Mar 4, 2016
Messages
7
Thank you in advance for anyone willing to solve this problem. I'm in need of a solution for an excel file in which each cell within two columns labeled, "Primary Diagnosis" and "Secondary Diagnosis" of a 100 column worksheet contain multiple ICD-9 or ICD-10(Industry Standard Diagnosis Codes) diagnosis codes. For example, ICD-10 code "J18.9" is assigned to the description, "Community acquired pneumonia" and "C50.912" is "Malignant neoplasm of left breast". Also, this daily file can contain any amount of rows/records so please factor this in.


Because each individual cell within the "Primary Diagnosis" field and "Secondary Diagnosis" fields contain many ICD-9 or ICD-10 codes, I am attempting break out the codes from these two columns into their respective column assignment of "First Diagnosis Description", "First Diagnosis Code", "Second Diagnosis Description", "Second Diagnosis Code", "Third Diagnosis Description", "Third Diagnosis Code", "Fourth Diagnosis Description", "Fourth Diagnosis Code" and so on. This expansion will go on until the 30th(60 columns) but not all 60 columns will be used depending on how many ICD-9/ICD-10 codes are housed within the cell.

I am very familiar with the text to columns function, however, it wont work to 100% accuracy because of the way each cell is configured in "Primary Diagnosis" field and "Secondary Diagnosis" columns. If one were to use the "Text to Columns" excel function with the delimiters set at ";" and "(" then the output to subsequent columns would place values in the incorrect columns. An example below, "Non-ST elevation myocardial infarction (NSTEMI), initial care episode (I21.4);" would output to subsequent columns as such, 1st Diagnosis Description -"Non-ST elevation myocardial infarction", 1st Diagnosis Code - "NSTEMI, initial care episode)" and 2nd Diagnosis Description - "I21.4)" instead of 2nd Diagnosis Description - "Non-ST elevation myocardial infarction (NSTEMI), initial care episode",1st Diagnosis Code -"I21.4)". Another example is, "Hypertension; Hypertension (I10);" will incorrectly output to, 1st Diagnosis Description - "Hypertension", 1st Diagnosis Code - "Hypertension", 2nd Diagnosis Description - "I10)" instead of 1st Diagnosis Description - "Hypertension Hypertension" and 1st Diagnosis Code- "I10)". If this seems confusing, try plugging in the below example into excel and use the text to columns function with delimiters being set at ";" and "(" to see an example of the output.
Possible Multi-part VBA Solution: Is there a way to search for anything within parenthesis which contains a decimal point and move it over to its respective Diagnosis Code column(1st Diagnosis Code, 2nd Diagnosis Code, 3rd Diagnosis Code)and then move its associated description to its respective column(1st Diagnosis Description, 2nd Diagnosis Description) .

I will show a before and after example of what I am looking to achieve in the ideal sense-

Below is a small example of the file but without the 100 column layout I was referring to earlier:
Before
Medical Record NumberProviderPatientPrimary DiagnosisSecondary DiagnosisFinancial ClassReport DateBilling Provider
123456Doe, John S.Doe, Jane S.
Non-ST elevation myocardial infarction (NSTEMI), initial care episode (I21.4); Acute on chronic diastolic congestive heart failure, NYHA class 3 (I50.33); Multiple sclerosis (340);

<tbody>
</tbody>

Acute respiratory failure (J96.00); AF (atrial fibrillation) (I48.91); Hypertension; Hypertension (I10); Pneumonia (J18.9);Medicare1/1/15Doe, John S.
123456Doe, John SDoe, Jane S.Hypertension (401.9); Hypertension (I10);Acute respiratory failure (J96.00); AF (atrial fibrillation) (I48.91); Hypertension; Hypertension (I10); Pneumonia (J18.9);Oxford1/1/15Doe, John S.
123456Doe, John SDoe, Jane S.Counseling regarding advanced directives and goals of care (Z71.89);Acute ischemic stroke (I63.50); Cardiac arrest (I46.9); Cerebral anoxic injury (G93.1); Cerebrovascular accident (CVA) (I63.9); Non-ST elevation myocardial infarction (NSTEMI), initial care episode (I21.4);Medicaid1/1/15Doe, John S.
AFTER

<tbody>
</tbody>





Medical Record NumberProviderPatient1st Diagnosis Description1st Diagnosis Code2nd Diagnosis Description2nd Diagnosis Code3rd Diagnosis Description3rd Diagnosis Code4th Diagnosis Description4th Diagnosis Code5th Diagnosis Description5th Diagnosis Code6th Diagnosis Description6th Diagnosis Code7th Diagnosis Description7th Diagnosis CodeFinancial ClassReport DateBilling Provider
123456Doe, John S.Doe, Jane S.
Non-ST elevation myocardial infarction (NSTEMI), initial care episode

<tbody>
</tbody>

I21.4Acute on chronic diastolic congestive heart failure, NYHA class 3I50.33Multiple sclerosis340Acute respiratory failureJ96.00AF (atrial fibrillation)I48.91Hypertension; HypertensionI10PneumoniaJ18.9Medicare1/1/15Doe, John S.
123456Doe, John SDoe, Jane S.Hypertension401.9HypertensionI10Acute respiratory failureJ96.00AF (atrial fibrillation)I48.91Hypertension; HypertensionI10PneumoniaJ18.9Oxford1/1/15Doe, John S.
123456Doe, John SDoe, Jane S.Counseling regarding advanced directives and goals of care (Z71.89);Z71.89Acute ischemic strokeI63.50Cardiac arrestI46.9Cerebral anoxic injuryG93.1Cerebrovascular accident (CVA)I63.9Non-ST elevation myocardial infarction (NSTEMI), initial care episodeI21.4Me

<tbody>
</tbody>

 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Hi, austlee
Try this (run both macro):
I assumed:
-The original data has 8 columns
-There's always character ");" in the end of each diagnosis code
Code:
Sub a926581a()
Dim i As Long
Dim j As Long
Dim arr1
Dim arr2

Application.ScreenUpdating = False
arr1 = Range("F1:H1")
Cells(1, 64).Resize(1, 3) = arr1
arr2 = Split("1st Diagnosis Description:1st Diagnosis Code:2nd Diagnosis Description" & _
":2nd Diagnosis Code:3rd Diagnosis Description:3rd Diagnosis Code", ":")
Cells(1, 4).Resize(1, 6) = arr2
j = 4

For i = 10 To 63
    Cells(1, i) = j & "th" & " Diagnosis Description"
    i = i + 1
    Cells(1, i) = j & "th" & " Diagnosis Code"
    j = j + 1
Next i

    'change column width
    Columns("A:C").ColumnWidth = 12
    Columns("BL:BN").ColumnWidth = 12
    
    For i = 4 To 63 Step 2
    Columns(i).ColumnWidth = 12
    Next i

    Cells.VerticalAlignment = xlVAlignTop
    Cells.WrapText = True
       Application.ScreenUpdating = True
End Sub



Sub a926581b()
    Dim strPattern As String
    Dim strReplace As String
    Dim regEx As Object
    Dim strInput As String
    Dim r As Range
    Dim vEnd
    Dim arr1
    
       Application.ScreenUpdating = False
    For Each r In Range("D2", Cells(Rows.count, "D").End(xlUp))
        vEnd = Range(Cells(r.row, 6), Cells(r.row, 8))
        Set regEx = CreateObject("VBScript.RegExp")
        strPattern = "\(([0-9A-Z\.]{1,})\);"
        strReplace = "@@$1@@"
        strInput = r.Value & r.Offset(0, 1).Value
      
        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .Pattern = strPattern
        End With

        If regEx.test(strInput) Then
           strInput = regEx.Replace(strInput, strReplace)
           arr1 = Split(strInput, "@@")
           r.Offset(0, 60).Resize(1, 3) = vEnd
           r.Resize(1, UBound(arr1)) = arr1
           
        End If
    Next
    Cells.VerticalAlignment = xlVAlignTop
    Cells.WrapText = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You're welcome & thanks for the reply.
 
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top