Flattening every other row..kind of.. Easy Q

[jsvlad]

I have data as such:


01a 01aa 01b 01bb 01c 01cc
02a 02aa 02b 02bb 02c 02cc
03a 03aa 03b 03bb 03c 03cc
04a 04aa 04b 04bb 04c 04cc
05a 05aa 05b 05bb 05c 05cc
06a 06aa 06b 06bb 06c 06cc
07a 07aa 07b 07bb 07c 07cc
08a 08aa 08b 08bb 08c 08cc
09a 09aa 09b 09bb 09c 09cc
10a 10aa 10b 10bb 10c 10cc
11a 11aa 11b 11bb 11c 11cc
12a 12aa 12b 12bb 12c 12cc
13a 13aa 13b 13bb 13c 13cc
14a 14aa 14b 14bb 14c 14cc
15a 15aa 15b 15bb 15c 15cc

where
a1 = 01a
a2=02a
a3 = 03a

and
b1 = 01aa
b2 02aa
b3 = 03aa

I want to rearrange the data with a macro as follows:

01a 01aa
01b 01bb
01c 01cc
02a 02aa
02b 02bb
02c 02cc
03a 03aa
03b 03bb
03c 03cc
04a 04aa
04b 04bb
04c 04cc
05a 05aa
05b 05bb
05c 05cc
...etc..


(thats 2 columns, and since it is 15 rows of data, it would be 15*3 =45 rows total when half flattened, and with 2 columns)





Future data might be 20 rows or different number of rows.
Future data might have a blank cell i.e. 13b and 13bb might be blank. in that case, the macro should just skip.
please let me know how to do this!

thank you
jason

ps
i noticed that iti is basically..
inserting 3 rows,
then cut and paste data
then repeat for length (rows) of data.

or another way of saying this is to flatten out all the even columns then flatten the odd columns..

 

[Weaver]

This will transpose the data to a new sheet

Sub test99()
    Application.ScreenUpdating = False
    Set src = Sheets("sheet1") 'replace 'sheet1' with the name of the sheet with the data
    Set dst = Sheets.Add
    lr = src.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        For j = 0 To 2
            dst.Cells(i * 3 + j, 1).Resize(, 2).Value = src.Cells(i, 1 + j * 2).Resize(, 2).Value
        Next j
    Next i
End Sub

 

[jsvlad]

can you do this without a new sheet.. that is.. just simply rearrange the data. i do not want to "store" that data..
thanks

 

[Weaver]

just delete the original sheet

 

[jsvlad]

Hi

thank you for your sugestion.

unfortunately it did not work..

I get a situation where it results in:


1aa 1a
1bb 1b
1c 1cc
2aa 2a
2bb 2b
2c 2cc


always the 3rd one in the set (row 3,6,9..) is correct but the others are flipped...

any tips?

 

[mirabeau]

a suggestion

Sub rearrange()
Dim a, rs&, cs&, i&, j&, k&
With Range("A1")
a = .CurrentRegion
rs = UBound(a, 1)
cs = UBound(a, 2)
If cs Mod 2 = 1 Then MsgBox "Odd number of columns": Exit Sub
ReDim c(1 To rs * cs / 2, 1 To 2)
For i = 1 To rs
    For j = 1 To cs Step 2
        k = k + 1
        c(k, 1) = a(i, j)
        c(k, 2) = a(i, j + 1)
Next j, i
.Resize(rs, cs).ClearContents
.Resize(k, 2) = c
End With
End Sub

 

[jsvlad]

excellent! thank you so much!