Transposing Data

[JoelBrown]

Hi There,

I am extracting data from some PDF documents and the data has been put into a spread sheet as a csv.

I am trying to move multiple rows of data into columns that come underneath each other. Each row is roughly 520 cells long or there about, I require each individual row to be split into a table like grid. Unfortunately it is not the same amount of cells in length for each individual split.

I have gone fabricated the values in the document as an example and moved the data manually into the grid like table I require.

These are the "moves" I require VBA to do for me and if anyone could help that would be greatly appreciated.

A2 to I2 to stay as they are,
J2 to V2 to move to H3 to T3
W2 to AI2 to move to H4 to T4
AJ2 to AV2 to move to H5 to T5
AW2 to BI2 to move to H6 to T6
BJ2 to BV2 to move to H7 to T7
BW2 to CI2 to move to H8 to T8
CJ2 to CV2 to move to H9 to T9
CW2 to DI2 to move to H10 to T10
DJ2 to DV2 to move to H11 to T11
DW2 to DX2 to move to H12 to I12
DY2 to EK2 to move to H13 to T13
EL2 to EX2 to move to H14 to T14
EY2 to FK2 to move to H15 to T15
FL2 to FX2 to move to H16 to T16
FY2 to GK2 to move to H17 to T17
GL2 to GX2 to move to H18 to T18
GY2 to HK2 to move to H19 to T19
HL2 to HX2 to move to H20 to T20
HY2 to HZ2 to move to H21 to I21
IA2 to IM2 to move to H22 to T22
IN2 to IZ2 to move to H23 to T23
JA2 to JM2 to move to H24 to T24
JN2 to JZ2 to move to H25 to T25
KA2 to KM2 to move to H26 to T26
KN2 to KZ2 to move to H27 to T27
LA2 to LB2 to move to H28 to I28
LC2 to LO2 to move to H29 to T29

The reason some are in red is because they are the ones that are shorter in length.

Here is a link to the document with the example... the cells would normally appear to start in row 1.

https://www.dropbox.com/s/l8p2wzypczhsmcp/report.xlsm?dl=0

Thanks in advance,

Joel

 

[onlyadrafter]

Hello,

does this code work as expected?

Sub SORT()
    MY_LAST_ROW = Range("A" & Rows.Count).End(xlUp).Row
    For MY_ROWS = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
        For MY_COLS = ActiveSheet.UsedRange.Columns.Count To 10 Step -1
            If Mid(Cells(MY_ROWS, MY_COLS).Value, 3, 1) = "." Then
                For MY_NEW_COLS = MY_COLS To 10 - 1 Step -1
                    If Mid(Cells(MY_ROWS, MY_NEW_COLS).Value, 3, 1) = "." Then
                        Range(Cells(MY_ROWS, MY_NEW_COLS), Cells(MY_ROWS, Columns.Count)).Copy
                        Cells(MY_ROWS + 1, 8).Insert Shift:=xlDown
                        If MY_ROWS <> MY_LAST_ROW Then
                            Range("A" & MY_ROWS + 1 & ":G" & MY_ROWS + 1).Insert (xlDown)
                        End If
                        Range(Cells(MY_ROWS, MY_NEW_COLS), Cells(MY_ROWS, Columns.Count)).ClearContents
                        MY_COLS = MY_COLS - MY_OFFSET
                        MY_OFFSET = 0
                    Else
                        MY_OFFSET = MY_OFFSET + 1
                    End If
                Next MY_NEW_COLS
            End If
        Next MY_COLS
    Next MY_ROWS
End Sub

isn't the most elegant, but gives the same results as per your example.