Converting vertical data to horizontal data in rows

[rtardif]

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.

MSH	KENNEDY
CRITICAL ERROR: unable to match patient
PID	BUNNY, BUGS	DOB	M	ADDRESS	PHONE
CRITICAL ERROR: unable to match patient
MSH	KENNEDY
ERROR: invalid data
PID	BUNNY, LOLA	DOB	F	ADDRESS
OBR	ABD US
MSH	INTERGY-RIS
ERROR: missing provider
PID	DEVIL, TAZ	DOB	M		PHONE
IN1	UNITED HEALTH
MSH	LABCORP
ERROR: invalid data
PID	LEGHORN, FOGHORN	DOB	M	ADDRESS	PHONE
OBR	LYME DISEASE
OBR	STREP

<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, BUGS	DOB	M	ADDRESS	PHONE			KENNEDY	CRITICAL ERROR
BUNNY, LOLA	DOB	F	ADDRESS			ABD US	KENNEDY	ERROR: invalid data
DEVIL, TAZ	DOB	M		PHONE	UNITED HEALTH		INTERGY-RIS	ERROR: missing provider
LEGHORN, FOGHORN	DOB	M	ADDRESS	PHONE		STREP	LABCORP	ERROR: 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.

(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

 

[Eric W]

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:

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!

 

[rtardif]

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]

Glad it works for you!

Let us know if you have any more questions.