Transpose data with breakdown at every 28th row

beautify5 · Nov 16, 2017

Hello Experts,

I have been trying to fit my head to find a solution but sadly haven't been able to.

I have huge data with 2 columns, there are 28 fields for each of the person dumped up in a single column. 1st column has the header data which obviously is repeated after every 28th rows and 2nd column has details about the persons.

I want to have the data from column 1 to be transposed as 28 columns and under this column/header there should be values from column 2 transposed to rows breakdown at every 28 cells. so 1st 28 values of the column 2 as row 1 and then next 28 values of the column 2 as row 2 and so on..

This might be a little confusing but i am sharing the demo work file, to make some sense. thanks a lot in advance!!

COLUM1 COLUMN2

asID	AA1
asName	AA2
asAddr	AA3
asCity	AA4
asST	AA5
asZIP	AA6
file	AA7
aseName	AA8
aseAddr	AA9
aseCity	AA10
aseST	AA11
aseZIP	AA12
CtrlNo	AA13
Wages	AA14
FedWH	AA15
SSWages	AA16
SSWh	AA17
midWage	AA18
midWH	AA19
RetPlan	AA20
CODE12	AA21
AMNT12	AA22
CODE12	AA23
AMNT12	AA24
StateCD	AA25
StateID	AA26
StatWage	AA27
StateWH	AA28
asID	BB1
asName	BB2
asAddr	BB3
asCity	BB4
asST	BB5
asZIP	BB6
file	BB7
aseName	BB8
aseAddr	BB9
aseCity	BB10
aseST	BB11
aseZIP	BB12
CtrlNo	BB13
Wages	BB14
FedWH	BB15
SSWages	BB16
SSWh	BB17
midWage	BB18
midWH	BB19
RetPlan	BB20
CODE12	BB21
AMNT12	BB22
CODE12	BB23
AMNT12	BB24
StateCD	BB25
StateID	BB26
StatWage	BB27
StateWH	BB28

After macro

asID

asName

asAddr

asCity

asST

asZIP

file

aseName

aseAddr

aseCity

aseST

aseZIP

CtrlNo

Wages

FedWH

SSWages

SSWh

midWage

midWH

RetPlan

CODE12

AMNT12

CODE12

AMNT12

StateCD

StateID

StatWage

StateWH

AA1

AA2

AA3

AA4

AA5

AA6

AA7

AA8

AA9

AA10

AA11

AA12

AA13

AA14

AA15

AA16

AA17

AA18

AA19

AA20

AA21

AA22

AA23

AA24

AA25

AA26

AA27

AA28

BB1

BB2

BB3

BB4

BB5

BB6

BB7

BB8

BB9

BB10

BB11

BB12

BB13

BB14

BB15

BB16

BB17

BB18

BB19

BB20

BB21

BB22

BB23

BB24

BB25

BB26

BB27

BB28

Takae · Nov 16, 2017

Hope this helps.

Code:

Sub trp()
Dim i As Long, j As Long
Dim rng As Range
j = 2
Range("D1:AE1").Value = WorksheetFunction.Transpose(Range("A1:A28"))
For i = 1 To cells(Rows.count, 2).End(xlUp).row Step 28
    Range(cells(j, 4), cells(j, 31)).Value = WorksheetFunction.Transpose(Range(cells(i, 2), cells(i + 27, 2)))
    j = j + 1
Next
End Sub

beautify5 · Nov 16, 2017

Thank you, this is awesome!

I am sorry but i just realized there is inconsistency with the data. so for few individuals there aren't all the 28 fields, so some are having 24 or 26. Can you please do me a favor and suggest a way with 28 row not being trigger to break down but Column 1 value "asID" as the trigger for having the data breakdown for each separate row. I hope i am not sounding confused.

In simple words result should have each row starting with value corresponding for ASID and similarly have the respective values of the 28 header populated and have the values blank for the respective row header which isn't present. example as below:

asID	AA1
asName	AA2
asAddr	AA3
asCity	AA4
asST	AA5
asZIP	AA6
file	AA7
aseName	AA8
aseAddr	AA9

asID	BB1
asName	BB2

asCity	BB4
asST	BB5

file	BB7
aseName	BB8

Result:

asID

asName

asAddr

asCity

asST

asZIP

file

aseName

aseAddr

AA1

AA2

AA3

AA4

AA5

AA6

AA7

AA8

AA9

BB1

BB2

BB4

BB5

BB7

BB8

BB9

Takae said:

Hope this helps.

Code:

Sub trp()
Dim i As Long, j As Long
Dim rng As Range
j = 2
Range("D1:AE1").Value = WorksheetFunction.Transpose(Range("A1:A28"))
For i = 1 To cells(Rows.count, 2).End(xlUp).row Step 28
    Range(cells(j, 4), cells(j, 31)).Value = WorksheetFunction.Transpose(Range(cells(i, 2), cells(i + 27, 2)))
    j = j + 1
Next
End Sub

Takae · Nov 16, 2017

Does the first column have blanks? If the first column has blanks, my code will work almost correctly because "asID" shows up every 28 rows.
If the first column does not have blanks, I know my code will not work correctly.
Or does the blanks may or may not appear with regularity like your second sample? Between AA9 and BB1 has just one blank row.

beautify5 · Nov 17, 2017

The above code didn't work well. So, actually there are no blank cells but they are missing. so in my example i know i left blank cells but what i meant was the cells arent even present there. However, AsID is always there and the AA1,BB1,CC1 values would always be there.

Fluff · Nov 18, 2017

In data you posted in post#1 some of the headers are repeated (code12, amnt12) is this actually the case in your real data?
If not are you happy to have the headers in another sheet that can be copied over?

Fluff · Nov 18, 2017

If the answer to the 1st question above is no & to the 2nd is yes, try

Code:

Sub CopyTransposeWithBlanks()

    Dim Ary As Variant
    Dim Ar As Areas
    Dim Rng As Range
    Dim Cl As Range
    Dim Rw As Long
    Dim Col As Long
    
Application.ScreenUpdating = False

    Ary = Sheets("[COLOR=#ff0000]Master[/COLOR]").Range("A1:AB1").Value
    With Sheets("[COLOR=#ff0000]Test1[/COLOR]")
        With .Range("A1", .Range("A" & Rows.Count).End(xlDown))
            .Replace "asID", True, xlWhole, , True, , False, False
            .SpecialCells(xlConstants, xlLogical).EntireRow.Insert
            .Replace True, "asID", xlWhole, , True, , False, False
            Set Ar = .SpecialCells(xlConstants).Areas
        End With
        
        .Range("C1").Resize(, 28).Value = Ary
        Rw = 2
        For Each Rng In Ar
            For Each Cl In Rng
                Col = WorksheetFunction.Match(Cl, Ary, 0)
                Cl.Offset(, 1).copy .Cells(Rw, Col + 2)
            Next Cl
            Rw = Rw + 1
        Next Rng
    End With

End Sub

changing the sheet names in red to suit

Fluff · Nov 18, 2017

This will deal with the two duplicated headers, but if one is missing the data may go into the wrong column.

Code:

Sub CopyTransposeWithBlanks()

    Dim Ary As Variant
    Dim Ar As Areas
    Dim Rng As Range
    Dim Cl As Range
    Dim Rw As Long
    Dim Col As Long
    
Application.ScreenUpdating = False

    Ary = Sheets("[COLOR=#ff0000]Master[/COLOR]").Range("A1:AB1").Value
    With Sheets("[COLOR=#ff0000]Test1[/COLOR]")
        With .Range("A1", .Range("A" & Rows.Count).End(xlDown))
            .Replace "asID", True, xlWhole, , True, , False, False
            .SpecialCells(xlConstants, xlLogical).EntireRow.Insert
            .Replace True, "asID", xlWhole, , True, , False, False
            Set Ar = .SpecialCells(xlConstants).Areas
        End With
        
        .Range("C1").Resize(, 28).Value = Ary
        Rw = 2
        For Each Rng In Ar
            For Each Cl In Rng
                Col = WorksheetFunction.Match(Cl, Ary, 0)
                If Col = 21 And .Cells(Rw, Col + 2) <> "" Then
                    Col = 23
                ElseIf Col = 22 And .Cells(Rw, Col + 2) <> "" Then
                    Col = 24
                End If
                Cl.Offset(, 1).copy .Cells(Rw, Col + 2)
            Next Cl
            Rw = Rw + 1
        Next Rng
    End With

End Sub

Once again, change sheet names to suit

beautify5 · Nov 20, 2017

This helped a lot, thank you!!

Fluff · Nov 20, 2017

Glad to help & thanks for the feedback

Transpose data with breakdown at every 28th row

beautify5

New Member

Excel Facts

Takae

Well-known Member

beautify5

New Member

Takae

Well-known Member

beautify5

New Member

Fluff

MrExcel MVP, Moderator

Fluff

MrExcel MVP, Moderator

Fluff

MrExcel MVP, Moderator

beautify5

New Member

Fluff

MrExcel MVP, Moderator

Forum statistics

Share this page

Transpose data with breakdown at every 28th row

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

MrExcel MVP, Moderator

MrExcel MVP, Moderator

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock