0

I have a table in Excel that is filled as below

PROD         JAN-19     FEB-19    ...     ...

product1      123        098      ...     ...
product2      314        467      ...     ...

I would need to use the data in a pivot table so I suppose I should transform the datamodel in the following way using the MMM-YY header as data in the Year and Month field.

 PROD          Year    Month     Data

 Product1       19      JAN       123
 Product1       19      FEB       098
 ...           ...      ...       ...

Below a screen of the actual table and what I would like to achieve: screen

Is there a practical way to do so either working on the Datamodel in which the table is uploaded or as last option VBA?.

Peter
  • 4,752
  • 2
  • 20
  • 32
Donats
  • 19
  • 4
  • Allow me the question if you could try my solution to create a data base for a Pivot table - Feel free to mark my approach as correct if it was helpful. Acceptance is indicated by a *green colored checkmark* next to the answer - cf. [Someone answers](https://stackoverflow.com/help/someone-answers). And take the (tour)[https://stackoverflow.com/tour]. Marking the answer will help other developers to not go into this question because it is resolved and to focus on other questions. Thanks! – T.M. Oct 28 '19 at 16:07

1 Answers1

0

Array Transformation via Application.Index()

This approach assigns the table values to an array first and eventually transforms the same array to the wanted structure using the extended features of the Application.Index() function thus maintaining the product names.

I don't pretend this to be the most efficient way, but it clearly demonstrates the possibilities of the cited function - c.f. Some pecularaties of the Application.Index function

Further note: I assume that all month data are included, i.e. even empty values.

Sub Table2PivotBase()
' Purpose: Transform Table to Pivot base
' Method:  reorganize Datafield array of table using advanced features of Application.Index in [2]d)
' Note:    sheet references use the worksheet's CodeName property here
'~~~~~~~~~~~~ [0] Reference to table (address) ~~~~~~
Const MONTHSCOUNT& = 12, COLUMNOFFSET& = 1    ' number of months, column offset January = 1 (i.e. 2nd col)
With Sheet1
'a) Refer to table using the sheet's CodeName
    Dim rpt As ListObject
    Set rpt = .ListObjects("Table1")
Sheet1.CodeName
' ~~~~~~~~~~~ [1] Get Data ~~~~~~~~~~~~~~~~~~~~~~~~
'b) Assign table values in Sheet1 to 2-dim 1-based array
    Dim arr As Variant, yr&
    arr = .Range(rpt.Range.Address).Value2
'c) Extract current year from 1st month column in header (1+ coloffset 1 => 2nd column)
    yr = Val(Split(arr(1, 1 + COLUMNOFFSET) & "-", "-")(1))
End With

'~~~~~~~~~~~~~~ [2] Reorganize Data ~~~~~~~~~~~~~~~
'd) Redimension array preserving 1st column
    Dim arr2, ItemsCount&
    ItemsCount = UBound(arr) - IIf(rpt.ShowTotals, 1, 0)    ' exclude table totals from items count
    arr2 = Application.Index(arr, Application.Transpose(getRowsArr(ItemsCount, MONTHSCOUNT)), Array(1, 1, 1, 2))

'e) Redefine headers in 1st row
    Dim no&, headers
    headers = Array("Product", "Year", "Month", "Data")
    For no = 1 To 4
        arr2(1, no) = headers(no - 1)               ' headers are zerobased
    Next no
'f) Enter year, month & month data in a loop
    Const START& = 2
    Dim i&, mon&, ii&
    ii = START - 1
    For i = START To UBound(arr2)
            mon = (i - START) Mod MONTHSCOUNT + 1   ' 0 to 11 (omitting 1 caption row) + 1
            If mon = 1 Then ii = ii + 1             ' increment data row of arr1 in January

           'arr2(i, 1) has already been prefilled by section [2]d)
            arr2(i, 2) = yr
            arr2(i, 3) = Application.Text(DateSerial(yr, mon, 1), "mmm")
            arr2(i, 4) = arr(ii, mon + COLUMNOFFSET)
    Next i


'~~~~~~~~~~~~ ~[3] Write back pivot base to any sheet (via CodeName) ~~~~~~~~~~~
With Sheet2
    .Range("A:D") = vbNullString
    .Range("A1").Resize(UBound(arr2), UBound(arr2, 2)) = arr2
End With
End Sub

Helper function getRowsArr()


Function getRowsArr(ByVal ItemsCount, Optional ByVal n& = 12) As Variant()
' Purpose: return 1-dim 0-based array containing n row numbers per item + title row no 1
' Note:    allows restructuring the original array to contain all months data
    Const START& = 2                        ' data rang starts in 2nd row
    Dim tmp(), i&, ii&
    ReDim tmp(0 To (ItemsCount - 1) * n)    ' includes header row number 1 at tmp(0) - zerobound!
'1) fill temporary array
    tmp(0) = 1                              ' title row no equals 1
    For i = START To ItemsCount             ' row no 2 to ...
        For ii = 0 To n - 1                 ' repeat row number n times
            tmp((i - START) * n + ii + 1) = i
        Next ii
    Next i
'2) return Array(1,2,2,2,2,2,2,2,2,2,2,2,2,3,........3,4...,...) as function value
    getRowsArr = tmp
    'Debug.Print Left$(Join(tmp, ","), 65) & "..."
End Function



T.M.
  • 9,436
  • 3
  • 33
  • 57