Converting vertical data to horizontal data in rows

rtardif

New Member
Joined
Sep 27, 2019
Messages
2
Hello. I'm fairly new with VBA. I have data that is more of a vertical format, but I need to move it to a new worksheet, and put all of the data for one patient on a single row. Please look at the following data example to understand my explanation.

Each new patient record always starts with MSH in the A column. After than is a row with an error, followed by the patient data. After that, there may or may not be one or more rows with OBR in column A. There may or may not be a row with IN1 in column A. And if Column A contains 'critical error', then the last row for that patient will always be a duplicate of the error line that immediately following the MSH row. The value in column A is always one of the following (MSH, CRITICAL ERROR or ERROR, PID, OBR, IN1), however the error will be followed by more text.
MSHKENNEDY
CRITICAL ERROR: unable to match patient
PIDBUNNY, BUGSDOBMADDRESSPHONE
CRITICAL ERROR: unable to match patient
MSHKENNEDY
ERROR: invalid data
PIDBUNNY, LOLADOBFADDRESS
OBRABD US
MSHINTERGY-RIS
ERROR: missing provider
PIDDEVIL, TAZDOBMPHONE
IN1UNITED HEALTH
MSHLABCORP
ERROR: invalid data
PIDLEGHORN, FOGHORNDOBMADDRESSPHONE
OBRLYME DISEASE
OBRSTREP

<tbody>
</tbody>

I need for this data to look like the following example, on it's own spreadsheet within the same workbook.

There can be multiple rows per patient for the OBRs, but only one of them needs to be copied. I used the last one, since my thought was just to keep copying them, and the last one would be the one that would stick. If the error is a critical error, the last row before the next patient will always be a duplicate of the row that is right after the MSH, so again, it can be copied over with no harm.

BUNNY, BUGSDOBMADDRESSPHONEKENNEDYCRITICAL ERROR
BUNNY, LOLADOBFADDRESSABD USKENNEDYERROR: invalid data
DEVIL, TAZDOBMPHONEUNITED HEALTHINTERGY-RISERROR: missing provider
LEGHORN, FOGHORNDOBMADDRESSPHONESTREPLABCORPERROR: invalid data

<tbody>
</tbody>

Any help would be greatly appreciated, since I have no idea how to make this work, especially with the variable number of rows for each patient. :confused:

(Note: If anyone is familiar with HL7 messages, I'm converting HL7 messages to an Excel format. I'm willing to share everything else I've done if you're interested.)

Thank you very much,
Robin Tardif
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
10,837
Welcome to MrExcel!

Try this. Open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to insert a new module. Paste the following code into the window that opens:

Rich (BB code):
Sub OrganizePatients()
Dim outdata(1 To 1, 1 To 9), sh1 As Worksheet, sh2 As Worksheet
Dim r As Long, r2 As Long, MyData As Variant

    Set sh1 = Sheets("Sheet4")
    Set sh2 = Sheets("Sheet5")
    sh2.Cells.ClearContents
    
    r2 = 1
    MyData = sh1.Range("A1").Resize(sh1.Cells(Rows.Count, "A").End(xlUp).Row, 6).Value
    
    For r = 1 To UBound(MyData)
        Select Case MyData(r, 1)
            Case "MSH"
                sh2.Cells(r2, "A").Resize(1, 9) = outdata
                r2 = r2 + 1
                Erase outdata
                outdata(1, 8) = MyData(r, 2)
            Case "PID"
                outdata(1, 1) = MyData(r, 2)
                outdata(1, 2) = MyData(r, 3)
                outdata(1, 3) = MyData(r, 4)
                outdata(1, 4) = MyData(r, 5)
                outdata(1, 5) = MyData(r, 6)
            Case "OBR"
                outdata(1, 7) = MyData(r, 2)
            Case "IN1"
                outdata(1, 6) = MyData(r, 2)
            Case Else
                outdata(1, 9) = MyData(r, 1)
        End Select
    Next r
    sh2.Cells(r2, "A").Resize(1, 9) = outdata
        
End Sub
Change the sheet names (in red) to match your workbook. The first should be the sheet with your data. The second should be the sheet where you want to put the reorganized data. It should already exist, and have nothing on it. Now press Alt-Q to close the editor. Press Alt-F8 to pull up the macro selector. Select OrganizePatients and click Run.

Let us know if this works for you! :)
 
Last edited:

rtardif

New Member
Joined
Sep 27, 2019
Messages
2
BRILLIANT! Thank you so very much! It worked perfectly. You just saved me hours of work trying out how to figure this out on my own.

Thank you, again!

Robin
 

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
10,837
Glad it works for you! :cool:

Let us know if you have any more questions.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,435
Messages
5,642,104
Members
417,256
Latest member
JessAw

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
Top