Macro - Convert Horizontal data into Vertical Data, 12 periods

E

EhhMikey

New Member
Joined
Jun 28, 2017
Messages
36
Hello all,

I hope you are well and would like to thank you for the 1000 of times MrExcel has saved me.

If someone knows a macro that could convert some horizontal data I have into vertical data it would save me hours of manual work. Unfortunately, I'm pretty new to creating Macros and have not become this advanced yet. I did find another post similar and tried to copy the macro but continually got the "Subscript out of range" Error.

I need to create this:
[TABLE="width: 517"]
<colgroup><col><col><col span="2"><col span="4"><col span="2"><col span="6"></colgroup><tbody>[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]P01[/TD]
[TD]P02[/TD]
[TD]P03[/TD]
[TD]P04[/TD]
[TD]P05[/TD]
[TD]P06[/TD]
[TD]P07[/TD]
[TD]P08[/TD]
[TD]P09[/TD]
[TD]P10[/TD]
[TD]P11[/TD]
[TD]P12[/TD]
[/TR]
[TR]
[TD] Data1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD] 25[/TD]
[TD] 35[/TD]
[TD] 45[/TD]
[TD] 55[/TD]
[TD] 100[/TD]
[TD] 200[/TD]
[TD] 45[/TD]
[TD] 2[/TD]
[TD] 8[/TD]
[TD] 9[/TD]
[TD] 57[/TD]
[TD] 22[/TD]
[/TR]
</tbody>[/TABLE]


Into this:
[TABLE="width: 384"]
<colgroup><col span="6"></colgroup><tbody>[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P1[/TD]
[TD="align: right"]25[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P2[/TD]
[TD="align: right"]35[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P3[/TD]
[TD="align: right"]45[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P4[/TD]
[TD="align: right"]55[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P5[/TD]
[TD="align: right"]100[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P6[/TD]
[TD="align: right"]200[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P7[/TD]
[TD="align: right"]45[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P8[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P9[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P10[/TD]
[TD="align: right"]9[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P11[/TD]
[TD="align: right"]57[/TD]
[/TR]
[TR]
[TD] Data 1 [/TD]
[TD] Data2 [/TD]
[TD]Data3[/TD]
[TD]Data4[/TD]
[TD]P12[/TD]
[TD="align: right"]22[/TD]
[/TR]
</tbody>[/TABLE]


Anything helps!

Cheers,

Michael
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
To be clear i will also need this repeated 100s of times with columns 1-4 interchanging multiple times.
 
Upvote 0
This isn't a macro, but is done by just 2 formulae ...

assuming data is in A1:P2, then ...

* in A5 enter .... =A$2 ... then drag this across to D5, then down to D16.

* in E5 enter ... =OFFSET($A$1,COLUMN()-5,ROW()-1) .... then drag this across to F5, then down to F16

I'm guessing however that your data isn't currently positioned in A1:P2, so the 2 formulae would need to be adjusted a little.

If you can't figure how to adjust it to your needs, private message me with where your data is and I'll adjust it for you.

Kind regards,

Chris
 
Upvote 0
Hi,

VBA code should UnPivot Data into database format. Item in Bold where change range and column headers to repeat.
Macro code also checks and creates "UnPivot Data Files" folder wherever default location for VBA executing this code.
A new file would be created under "UnPivot Data Files" folder like "Data 2017-06-29 23-18-03.xlsx".

Hope the macro code below answers your question.
Excel Workbook
ABCDEFGHIJKLMNOP
1HD1HD2HD3HD4P01P02P03P04P05P06P07P08P09P10P11P12
2Data1Data2Data3Data425354555100200452895722
Sheet1



?

?

<!-- ######### End Created Html Code To Copy ########## -->

Create two Modules
1) modMain
Code: 
Option Explicit
'List: The range to be normalized.
 'RepeatingColsCount: The number of columns, starting with the leftmost,
 '   whose headings remain the same.
 'NormalizedColHeader: The column header for the rolled-up category.
 'DataColHeader: The column header for the normalized data.
 'NewWorkbook: Put the sheet with the data in a new workbook?
 '
 'NOTE: The data must be in a contiguous range and the
 'rows that will be repeated must be to the left,
 'with the rows to be normalized to the right.
Dim aStartTime
Const DblSpace As String = vbNewLine & vbNewLine
Const SpecialCharacters As String = "!,?,@,#,$,%,^,&,*,(,),{,[,],}"  'modify as needed
Dim strFullName As String
Dim ProcName As String
Dim bErrorHandle As Boolean
Dim SourceWbk As Workbook
Sub Test()
Dim lRow As Long, lCol As Long
Dim rngDel As Range
Dim ActWbk As Workbook
On Error GoTo errHandler
    bErrorHandle = False
'~~> Start Timer
    aStartTime = Now()
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(False)
    
    Set SourceWbk = ActiveWorkbook

[B]Call NormalizeList(Range("A1:P12"), 4, "Period", "Amount", True)[/B]
'~~> Tidy up
Set ActWbk = ActiveWorkbook
lCol = LastCol(Sheets("Sheet1"))
lRow = Cells(Rows.Count, lCol).End(xlUp).Row
Set rngDel = Range("A" & lRow + 1 & ":A" & Cells(Rows.Count, 1).End(xlUp).Row)
rngDel.EntireRow.Delete
'~~>
Call SaveAs(ActWbk)
BeforeExit:
    '~~> Remove items from memory
        Set ActWbk = Nothing
        Set SourceWbk = Nothing
        Set rngDel = Nothing
    
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(True)
    
    If bErrorHandle = False Then
        MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss") & vbNewLine _
            & DblSpace & " You're good to go!" & DblSpace & _
            "UnPivot Done" & Chr(169) & Chr(32) & Year(Date), vbInformation, "Excellent"
            
           '~~> Close Workbook with VBA Code too
            ThisWorkbook.Close False
    End If
    
    Exit Sub
errHandler:
    '~~> Error Occurred
    bErrorHandle = True
    ProcName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    MsgBox "Procedure: - " & ProcName & DblSpace & Err.Description, vbCritical, "Oops I did it again...."
    Resume BeforeExit
End Sub
 Sub NormalizeList(List As Excel.Range, RepeatingColsCount As Long, _
     NormalizedColHeader As String, DataColHeader As String, _
     Optional NewWorkbook As Boolean = False)
Dim FirstNormalizingCol As Long, NormalizingColsCount As Long
Dim ColsToRepeat As Excel.Range, ColsToNormalize As Excel.Range
Dim NormalizedRowsCount As Long
Dim RepeatingList() As String
Dim NormalizedList() As Variant
Dim ListIndex As Long, i As Long, j As Long
Dim wbSource As Excel.Workbook, wbTarget As Excel.Workbook
Dim wsTarget As Excel.Worksheet
 
 With List
     'If the normalized list won't fit, you must quit.
   If .Rows.Count * (.Columns.Count - RepeatingColsCount) > .Parent.Rows.Count Then
         MsgBox "The normalized list will be too many rows.", _
                vbExclamation + vbOKOnly, "Sorry"
         Exit Sub
     End If
    'You have the range to be normalized and the count of leftmost rows to be repeated.
    'This section uses those arguments to set the two ranges to parse
    'and the two corresponding arrays to fill
    FirstNormalizingCol = RepeatingColsCount + 1
     NormalizingColsCount = .Columns.Count - RepeatingColsCount
     Set ColsToRepeat = .Cells(1).Resize(.Rows.Count, RepeatingColsCount)
     Set ColsToNormalize = .Cells(1, FirstNormalizingCol).Resize(.Rows.Count, NormalizingColsCount)
     NormalizedRowsCount = ColsToNormalize.Columns.Count * .Rows.Count
     ReDim RepeatingList(1 To NormalizedRowsCount, 1 To RepeatingColsCount)
     ReDim NormalizedList(1 To NormalizedRowsCount, 1 To 2)
 End With
 
 'Fill in every i elements of the repeating array with the repeating row labels.
 For i = 1 To NormalizedRowsCount Step NormalizingColsCount
     ListIndex = ListIndex + 1
     For j = 1 To RepeatingColsCount
         RepeatingList(i, j) = List.Cells(ListIndex, j).Value2
     Next j
 Next i
 
 'We stepped over most rows above, so fill in other repeating array elements.
 For i = 1 To NormalizedRowsCount
     For j = 1 To RepeatingColsCount
         If RepeatingList(i, j) = "" Then
             RepeatingList(i, j) = RepeatingList(i - 1, j)
         End If
     Next j
 Next i
 
 'Fill in each element of the first dimension of the normalizing array
'with the former column header (which is now another row label) and the data.
 With ColsToNormalize
     For i = 1 To .Rows.Count
         For j = 1 To .Columns.Count
             NormalizedList(((i - 1) * NormalizingColsCount) + j, 1) = .Cells(1, j)
             NormalizedList(((i - 1) * NormalizingColsCount) + j, 2) = .Cells(i, j)
         Next j
     Next I
 End With
 
 If NewWorkbook Then
     Set wbTarget = Workbooks.Add
     Set wsTarget = wbTarget.Worksheets(1)
 Else
     Set wbSource = List.Parent.Parent
     With wbSource.Worksheets
         Set wsTarget = .Add(After:=.Item(.Count))
     End With
 End If
 
 With wsTarget
     'Put the data from the two arrays in the new worksheet.
    .Range("A1").Resize(NormalizedRowsCount, RepeatingColsCount) = RepeatingList
     .Cells(1, FirstNormalizingCol).Resize(NormalizedRowsCount, 2) = NormalizedList
 
     'At this point there will be repeated header rows, so delete all but one.
    .Range("1:" & NormalizingColsCount - 1).EntireRow.Delete
 
     'Add the headers for the new label column and the data column.
    .Cells(1, FirstNormalizingCol).Value = NormalizedColHeader
     .Cells(1, FirstNormalizingCol + 1).Value = DataColHeader
 End With
 End Sub
Private Sub SaveAs(wbDestination As Workbook)
    Dim strFile As String
    Dim NewFile As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim bIsDirectoryExist As Boolean
    Const ANewString As String = "Data"
    Const newFolder As String = "UnPivot Data Files"
    Const sExt As String = ".xlsx"
    
    On Error GoTo errHandler
    '~~> Speeding Up VBA Code
    Call SpeedUp(False)
    
    
    With wbDestination
        NewFile = Left(.Name, Len(.Name) - 5) & ANewString
        FileExtStr = sExt
        
        '~~> Checks If Directory Exists
        bIsDirectoryExist = IsDirectoryExist(SourceWbk.Path & Application.PathSeparator & newFolder)
        
        Select Case FileExtStr
        Case ".xlsb": FileFormatNum = 50
        Case ".xlsx": FileFormatNum = 51
        Case ".xlsm": FileFormatNum = 52
        Case ".xls": FileFormatNum = 56
        Case ".csv": FileFormatNum = 6
        Case ".txt": FileFormatNum = -4158
        Case ".prn": FileFormatNum = 36
        Case Else: FileFormatNum = 0
        End Select
        
        
        'Now we can create/Save the file with the xlFileFormat parameter
        'value that match the file extension
        If FileFormatNum = 0 Then
            MsgBox "Sorry, unknown file extension"
        Else
            '~~> Delete Parameters worksheet tab
            On Error Resume Next
            Sheets("Parameters").Delete
            On Error GoTo 0
            
            
            '~~> Saveas default file path location
            .SaveAs Filename:=SourceWbk.Path & Application.PathSeparator & newFolder & Application.PathSeparator & NewFile & " " & Format(Now(), "yyyy-MM-dd hh-mm-ss"), FileFormat:=FileFormatNum
            '~~> Save and close new file
            .Saved = True
            .Close
            
        End If
    End With
    
    
BeforeExit:
    '~~> Remove items from memory
    Set wbDestination = Nothing
    
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(True)
    
    '    If bErrorHandle = False Then
    '        MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss") & vbNewLine _
        '            & DblSpace & " You're good to go!" & DblSpace & _
        '            "Job Done! " & Chr(169) & Chr(32) & Year(Date), vbInformation, "Excellent"
    '    End If
    
    Exit Sub
errHandler:
    '~~> Error Occurred
    bErrorHandle = True
    ProcName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    MsgBox "Procedure: - " & ProcName & DblSpace & Err.Description, vbCritical, "Oops I did it again...."
    Resume BeforeExit
    
End Sub

2.modTools
Code: 
Option Explicit
Public Function SpeedUp(Optional bSpeed As Boolean = True)
With Application
    .ScreenUpdating = bSpeed 'Prevent screen flickering
    .Calculation = IIf(bSpeed, xlAutomatic, xlCalculationManual) 'Preventing calculation
    .DisplayAlerts = bSpeed 'Turn OFF alerts
    .EnableEvents = bSpeed 'Prevent All Events
End With
End Function
Function IsDirectoryExist(newFolder As String) As Boolean
If Len(Dir(newFolder, vbDirectory)) = 0 Then
   MkDir newFolder
End If
End Function

Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function


Kind Regards

Biz
 
Upvote 0
No, I didn't receive your private message.

I see Biz has written some code for you.

If you'd prefer to use his code, no problem, but if you'd prefer to keep it to just two formulae, let me know.

Kind regards,

Chris
 
Upvote 0
Thank you Biz,

I tried to just copy and paste that code but got the error message 'Run-Time Error 1004, programmatic access to Visual Basic Project is not trusted'

I think your code may be pretty complex with my level of VBA knowledge. Do you recommend a good online reference or book for learning Visual Basic? It's something I really need to add to improve the level of reporting I'm able to do. Also is there somewhere I can upload part of the data so I could share it? I think that would be most helpful for explaining what I'm trying to accomplish.

Biz was very close, but the HD1-HD4 headers all change, this is more or less exactly what the data looks like:

[TABLE="width: 1615"]
<colgroup><col span="2"><col><col span="12"></colgroup><tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]P01[/TD]
[TD]P02[/TD]
[TD]P03[/TD]
[TD]P04[/TD]
[TD]P05[/TD]
[TD]P06[/TD]
[TD]P07[/TD]
[TD]P08[/TD]
[TD]P09[/TD]
[TD]P10[/TD]
[TD]P11[/TD]
[TD]P12[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 3 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 4 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 5 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 6 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 7 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 8 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 9 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 10 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 11 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 12 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 13 [/TD]
[TD]Channel 1[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 2[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 3[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 4[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 5[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 6[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 7[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 8[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 9[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 10[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 11[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 12[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 13[/TD]
[TD]Channel 1[/TD]
[TD] Margin [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 2[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 3[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 4[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 5[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 6[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 7[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 8[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 9[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 10[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 11[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 12[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 13[/TD]
[TD]Channel 1[/TD]
[TD] Volume [/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 2[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 3[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 4[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 5[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 6[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 7[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 8[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 9[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 10[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 11[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 12[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD]Category 13[/TD]
[TD]Channel 2[/TD]
[TD]Sales[/TD]
[TD] 30.000[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[TD] 2.500[/TD]
[/TR]
</tbody>[/TABLE]

I need to change the columns into 12 rows with changing row data, i.e. the first two rows would generate the following data:

[TABLE="width: 445"]
<colgroup><col span="5"></colgroup><tbody>[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P01 [/TD]
[TD] 30.000[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P02 [/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P03 [/TD]
[TD] 10.000[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P04 [/TD]
[TD] 50.000[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P05 [/TD]
[TD] 100.000[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P06 [/TD]
[TD] 6.500[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P07 [/TD]
[TD] 7.500[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P08 [/TD]
[TD] 8.500[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P09 [/TD]
[TD] 9.800[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P10 [/TD]
[TD] 15.000[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P11 [/TD]
[TD] 20.000[/TD]
[/TR]
[TR]
[TD] Category 1 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P12 [/TD]
[TD] 1.000[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P01 [/TD]
[TD] 30.000[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P02 [/TD]
[TD] 2.500[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P03 [/TD]
[TD] 10.000[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P04 [/TD]
[TD] 50.000[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P05 [/TD]
[TD] 100.000[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P06 [/TD]
[TD] 6.500[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P07 [/TD]
[TD] 7.500[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P08 [/TD]
[TD] 8.500[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P09 [/TD]
[TD] 9.800[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P10 [/TD]
[TD] 15.000[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P11 [/TD]
[TD] 20.000[/TD]
[/TR]
[TR]
[TD] Category 2 [/TD]
[TD] Channel 1 [/TD]
[TD] Sales [/TD]
[TD] P12 [/TD]
[TD] 1.000[/TD]
[/TR]
</tbody>[/TABLE]

The end result will be possibly a couple hundred thousand rows, which is why I can't really do this manually.

Please let me know if this is helpful.

Michael
 
Upvote 0
Hi,

Let's try again with revised VBA code.

Please note two additional things have been added.
1) InputBox to capture the range to process
2) InputBox to capture RepeatColsCount on left side


Create two Modules
1) modMain

Code: 
Option Explicit
'List: The range to be normalized.
'RepeatingColsCount: The number of columns, starting with the leftmost,
'   whose headings remain the same.
'NormalizedColHeader: The column header for the rolled-up category.
'DataColHeader: The column header for the normalized data.
'NewWorkbook: Put the sheet with the data in a new workbook?
'
'NOTE: The data must be in a contiguous range and the
'rows that will be repeated must be to the left,
'with the rows to be normalized to the right.
Dim aStartTime
Const DblSpace As String = vbNewLine & vbNewLine
Const SpecialCharacters As String = "!,?,@,#,$,%,^,&,*,(,),{,[,],}"  'modify as needed
Dim strFullName As String
Dim ProcName As String
Dim bErrorHandle As Boolean
Dim SourceWbk As Workbook
Sub Test()
    Dim lRow As Long, lCol As Long
    Dim RepeatColsCount As Long
    Dim rngDel As Range
    Dim ActWbk As Workbook
    Dim UserRange As Range
    On Error GoTo errHandler
    bErrorHandle = False
    
    '~~> Start Timer
    aStartTime = Now()
    
    
    Set SourceWbk = ActiveWorkbook
    
    On Error Resume Next
    Set UserRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Default:=Selection.Address, Type:=8)
    If UserRange Is Nothing Then
        MsgBox "You press Cancel, this procedure will now terminate."
        Exit Sub
    End If
    
    
redo:
    Dim v As Variant
    v = Application.InputBox(Prompt:="How many columns, at the left side will repeat?", Title:="Input Whole Numbers Only", Type:=1)
    If v = "False" Then
        bErrorHandle = True
        MsgBox "Terminate Processing", vbCritical
        GoTo BeforeExit
    End If
    
    '<~~ More Testing for positive Integer only
    If v < 1 Or Not (v = Int(v)) Then
        MsgBox "How many columns are needed - this must be a postive integer?", vbCritical
        GoTo redo
    End If
    RepeatColsCount = Int(v)
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(False)
    
    Call NormalizeList(UserRange, RepeatColsCount, "Period", "Value", True)
    
    '~~> New UnPivot Data workbook
    Set ActWbk = ActiveWorkbook
    
    
    '~~>
    Call SaveAs(ActWbk)
    
BeforeExit:
    '~~> Remove items from memory
    Set ActWbk = Nothing
    Set SourceWbk = Nothing
    Set rngDel = Nothing
    
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(True)
    
    If bErrorHandle = False Then
        MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss") & vbNewLine _
            & DblSpace & " You're good to go!" & DblSpace & _
            "UnPivot Done" & Chr(169) & Chr(32) & Year(Date), vbInformation, "Excellent"
        
        '~~> Close Workbook with VBA Code too
        ThisWorkbook.Close False
    End If
    
    Exit Sub
errHandler:
    '~~> Error Occurred
    bErrorHandle = True
    ProcName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    MsgBox "Procedure: - " & ProcName & DblSpace & Err.Description, vbCritical, "Oops I did it again...."
    Resume BeforeExit
    
End Sub
Sub NormalizeList(List As Excel.Range, RepeatingColsCount As Long, _
    NormalizedColHeader As String, DataColHeader As String, _
    Optional NewWorkbook As Boolean = False)
Dim FirstNormalizingCol As Long, NormalizingColsCount As Long
Dim ColsToRepeat As Excel.Range, ColsToNormalize As Excel.Range
Dim NormalizedRowsCount As Long
Dim RepeatingList() As String
Dim NormalizedList() As Variant
Dim ListIndex As Long, i As Long, j As Long
Dim wbSource As Excel.Workbook, wbTarget As Excel.Workbook
Dim wsTarget As Excel.Worksheet
With List
    'If the normalized list won't fit, you must quit.
    If .Rows.Count * (.Columns.Count - RepeatingColsCount) > .Parent.Rows.Count Then
        MsgBox "The normalized list will be too many rows.", _
            vbExclamation + vbOKOnly, "Sorry"
        Exit Sub
    End If
    
    'You have the range to be normalized and the count of leftmost rows to be repeated.
    'This section uses those arguments to set the two ranges to parse
    'and the two corresponding arrays to fill
    FirstNormalizingCol = RepeatingColsCount + 1
    NormalizingColsCount = .Columns.Count - RepeatingColsCount
    Set ColsToRepeat = .Cells(1).Resize(.Rows.Count, RepeatingColsCount)
    Set ColsToNormalize = .Cells(1, FirstNormalizingCol).Resize(.Rows.Count, NormalizingColsCount)
    NormalizedRowsCount = ColsToNormalize.Columns.Count * .Rows.Count
    ReDim RepeatingList(1 To NormalizedRowsCount, 1 To RepeatingColsCount)
    ReDim NormalizedList(1 To NormalizedRowsCount, 1 To 2)
End With

'Fill in every i elements of the repeating array with the repeating row labels.
For i = 1 To NormalizedRowsCount Step NormalizingColsCount
    ListIndex = ListIndex + 1
    For j = 1 To RepeatingColsCount
        RepeatingList(i, j) = List.Cells(ListIndex, j).Value2
    Next j
Next i

'We stepped over most rows above, so fill in other repeating array elements.
For i = 1 To NormalizedRowsCount
    For j = 1 To RepeatingColsCount
        If RepeatingList(i, j) = "" Then
            RepeatingList(i, j) = RepeatingList(i - 1, j)
        End If
    Next j
Next i

'Fill in each element of the first dimension of the normalizing array
'with the former column header (which is now another row label) and the data.
With ColsToNormalize
    For i = 1 To .Rows.Count
        For j = 1 To .Columns.Count
            NormalizedList(((i - 1) * NormalizingColsCount) + j, 1) = .Cells(1, j)
            NormalizedList(((i - 1) * NormalizingColsCount) + j, 2) = .Cells(i, j)
        Next j
    Next i
End With
'Put the normal data in the same workbook, or a new one.
If NewWorkbook Then
    Set wbTarget = Workbooks.Add
    Set wsTarget = wbTarget.Worksheets(1)
Else
    Set wbSource = List.Parent.Parent
    With wbSource.Worksheets
        Set wsTarget = .Add(After:=.Item(.Count))
    End With
End If

With wsTarget
    'Put the data from the two arrays in the new worksheet.
    .Range("A1").Resize(NormalizedRowsCount, RepeatingColsCount) = RepeatingList
    .Cells(1, FirstNormalizingCol).Resize(NormalizedRowsCount, 2) = NormalizedList
    
    
    'At this point there will be repeated header rows, so delete all but one.
    .Range("1:" & NormalizingColsCount - 1).EntireRow.Delete
    
    
    'Add the headers for the new label column and the data column.
    .Cells(1, FirstNormalizingCol).Value = NormalizedColHeader
    .Cells(1, FirstNormalizingCol + 1).Value = DataColHeader
End With
End Sub
Private Sub SaveAs(wbDestination As Workbook)
    Dim strFile As String
    Dim NewFile As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim bIsDirectoryExist As Boolean
    Const ANewString As String = "Data"
    Const newFolder As String = "UnPivot Data Files"
    Const sExt As String = ".xlsx"
    
    On Error GoTo errHandler
    '~~> Speeding Up VBA Code
    Call SpeedUp(False)
    
    
    With wbDestination
        NewFile = Left(.Name, Len(.Name) - 5) & ANewString
        FileExtStr = sExt
        
        '~~> Checks If Directory Exists
        bIsDirectoryExist = IsDirectoryExist(SourceWbk.Path & Application.PathSeparator & newFolder)
        
        Select Case FileExtStr
        Case ".xlsb": FileFormatNum = 50
        Case ".xlsx": FileFormatNum = 51
        Case ".xlsm": FileFormatNum = 52
        Case ".xls": FileFormatNum = 56
        Case ".csv": FileFormatNum = 6
        Case ".txt": FileFormatNum = -4158
        Case ".prn": FileFormatNum = 36
        Case Else: FileFormatNum = 0
        End Select
        
        
        'Now we can create/Save the file with the xlFileFormat parameter
        'value that match the file extension
        If FileFormatNum = 0 Then
            MsgBox "Sorry, unknown file extension"
        Else
            '~~> Delete Parameters worksheet tab
            On Error Resume Next
            Sheets("Parameters").Delete
            On Error GoTo 0
            
            
            '~~> Saveas default file path location
            .SaveAs Filename:=SourceWbk.Path & Application.PathSeparator & newFolder & Application.PathSeparator & NewFile & " " & Format(Now(), "yyyy-MM-dd hh-mm-ss"), FileFormat:=FileFormatNum
            '~~> Save and close new file
            .Saved = True
            .Close
            
        End If
    End With
    
    
BeforeExit:
    '~~> Remove items from memory
    Set wbDestination = Nothing
    
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(True)
    
    '    If bErrorHandle = False Then
    '        MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss") & vbNewLine _
        '            & DblSpace & " You're good to go!" & DblSpace & _
        '            "Job Done! " & Chr(169) & Chr(32) & Year(Date), vbInformation, "Excellent"
    '    End If
    
    Exit Sub
errHandler:
    '~~> Error Occurred
    bErrorHandle = True
    ProcName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    MsgBox "Procedure: - " & ProcName & DblSpace & Err.Description, vbCritical, "Oops I did it again...."
    Resume BeforeExit
    
End Sub

2.modTools

Code: 
Public Function SpeedUp(Optional bSpeed As Boolean = True)
With Application
    .ScreenUpdating = bSpeed 'Prevent screen flickering
    .Calculation = IIf(bSpeed, xlAutomatic, xlCalculationManual) 'Preventing calculation
    .DisplayAlerts = bSpeed 'Turn OFF alerts
    .EnableEvents = bSpeed 'Prevent All Events
End With
End Function
Function IsDirectoryExist(newFolder As String) As Boolean
If Len(Dir(newFolder, vbDirectory)) = 0 Then
   MkDir newFolder
End If
End Function

Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function


Hope the code works as desired.

I have been to courses but you really learn when trying to build code for work and trying to help other people in this forum.
Everyday I'm learning new things.

Kind Regards

Biz
 
Upvote 0
Thanks Biz,

Working through the code now to develop an understanding of what I'm working with. Any chance you can move to private chat should I have any issues?

Appreciate the work here! This VBA is very impressive!
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
VBA copy data to formatted table while inserting new rows
Replies
0
Views
778
huzzle3
H
D
  • Question Question
Grand Total on Pivot Chart Graph
Replies
0
Views
842
Darmlucht
D
N
  • Question Question
Pivot Data Selection using VBA
Replies
3
Views
605
Prish
P
S
  • Question Question
Macro to extract Columns based on multiple criteria
Replies
6
Views
4K
Trebor76
T
P
  • Question Question
Automate creating a worksheet adding rows based on certain criterias (all this in the same workbook)
Replies
1
Views
828
pratikjoshi448
P

Forum statistics

Threads
1,223,895
Messages
6,175,257
Members
452,625
Latest member
saadat28

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top