Insert Horizontal data into a Vertical format

Question

I have a table of data such that specific columns of the information needs to be converted from a horizontal layout and inserted vertically below the initial row. To make things more complex any column with a value of zero needs to be ignored and each row may have a different column with a zero.

I have gotten thus far with the help of “DisplayName” from stackoverflow, but the thread went silent. I am pretty sure I had too many follow ups. Completely my fault as I was attempting to simplify the problem, which made getting me an answer even more difficult.

This query is super close, but for some reason when run it on this data set it is not picking up all the horizontal data. For some reason it is stopping at column "S" rather than going to column "CZ". Also in rows where there are zeros in column "B" it does not pick up the account number and just adds the Revenue Code and Charges to the name above it (see where account 123123141 was skipped, but the object numbers were added to 123123140).

If possible (which I can't figure out), I can attach the actual .xlsm file.

Sub H2V()
' Vertically integrate horizontal revenue code data
' Keyboard Shortcut: Ctrl+Shift+Q
Dim headers As Variant, names As Variant, data As Variant
Dim iRow As Long

With Worksheets("Template")
    With Intersect(.UsedRange, .Range("A:CZ"))
        headers = Application.Transpose(Application.Transpose(.Offset(, 1).Resize(1, .Columns.Count - 1).Value))
        names = Application.Transpose(.Offset(1).Resize(.Rows.Count - 1, 1).Value)
        data = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Value
        .ClearContents
        .Resize(1, 3).Value = Array("Patient Number", "Rev Code", "Charges")
    End With

    For iRow = 1 To UBound (data)
        With .Cells(.Rows.Count, "B").End(xlUp)
            .Offset(1, -1).Value = names(iRow)
            .Offset(1, 0).Resize(UBound(headers)).Value = Application.Transpose(headers)
            .Offset(1, 1).Resize(UBound(data)).Value = Application.Transpose(Application.Index(data, iRow, 0))
        End With
    Next

    With .Range("B3", Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeConstants)
        .Offset(, 1).Replace What:="0", Replacement:="", LookAt:=xlWhole
        .Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End With
End Sub

https://stackoverflow.com/a/27671495/1383168 – Slai Apr 28 '18 at 17:24 — Slai, Apr 28 '18 at 17:24

score 0 · Answer 1 · answered Apr 28 '18 at 16:56

This fixes the missing data out horizontally.. but it is still skipping account 123123141 and i am not sure why..

For iRow = 1 To UBound(data, 1)
        With .Cells(.Rows.Count, "B").End(xlUp)
            .Offset(1, -1).Value = names(iRow)
            .Offset(1, 0).Resize(UBound(headers)).Value = Application.Transpose(headers)
            .Offset(1, 1).Resize(UBound(data, 2)).Value = Application.Transpose(Application.Index(data, iRow, 0))
        End With
    Next

Insert Horizontal data into a Vertical format

1 Answers1