I would like convert data that is in four columns to a matrix table. I've tried to use OFFSET function and it works but my data is too large (about 100,000 cells) and it crashed.
So, I wound like to try to do this by macro, can you suggest how to do this? Or you have any better suggestion that would be great.
PS. I used OFFSET formula from this site here.
Pivoted with Type above Gear for ROWS, Color for COLUMNS and Sum of Amount for Σ VALUES:
with the top row hidden, the Report Layout shown in Tabular Form, all subtotals and totals removed, the order of columns and of rows rearranged, empty cells set to show 0, expand/collapse buttons hidden, Repeat All Item Labels set *, and borders added.
In order to show the row of 0s, I added Bus/Green/Manual to the source data (with a colour (Green) to avoid (blank) as an extra column).
* not available in Excel 2007. To repeat item labels for versions earlier than Excel 2010 the standard practice is to copy the PT and Paste Special, Values and fill the blanks by selecting them with Go To Special, Blanks then =, Up, Ctrl+Enter.
Fun problem! Because you were having problems involving the size of your data, I tried to avoid using objects like dictionaries(I don't know how much a dictionary can hold). Instead I created a program that keeps track of very little data, but ends up continuously reading/writing from the file: It'll be very slow, but it'll work for very large files.
Anyways, try copying and pasting the following code into a VBA module and then run it on your file. You may need to change some of the values for the rows and columns.
EDIT: I made it work for the example picture you gave, but it's a mess. I'll try to make it clearer tomorrow (g2g)
EDIT: It's been updated! Carefully commented etc, It'll be easy to modify however you like.
Summary
Example:
Code: (SO got rid of the whitespace :( I think my post is too long)
'Start and end row of the original data
Private dataStartRow As Long
Private dataEndRow As Long
'The start row/column of the matrix
Private matrixStartRow As Long
Private matrixStartCol As Long
'How many rows/columns in the matrix
Private matrixRowLength As Long
Private matrixColLength As Integer
Public Sub makeMatrixTable()
'Sets initial values for variables
initializeValues
'Builds table
buildTable
End Sub
Private Function initializeValues()
'The actual data probably begins on row 2, because row 1 is usually used for column titles
dataStartRow = 2
'Get last row of data
dataEndRow = ActiveSheet.UsedRange.Rows.Count
'By adding 2, we create a gap row between our new matrix table and the original data table
matrixStartRow = dataEndRow + 2
'The matrix values begin after column 2, because columns 1&2 are used for titles
matrixStartCol = 2
matrixRowLength = 0
matrixColLength = 0
End Function
Private Function buildTable()
Dim dataRow As Long
Dim matrixRow As Long
Dim matrixCol As Integer
Dim value As String
'The keys are the column/row titles
'I'm using the work "key" because we're mimicking a dictionary object by only using a key once
'in this case it's a little more complicated, as we have 3 keys (2 row keys, 1 column key)
Dim rowKey1 As String, rowKey2 As String
Dim colKey As String
'loop through all rows containing data
For dataRow = dataStartRow To dataEndRow
'get keys from data
rowKey1 = CStr(ActiveSheet.Cells(dataRow, 1).value)
rowKey2 = CStr(ActiveSheet.Cells(dataRow, 3).value)
colKey = CStr(ActiveSheet.Cells(dataRow, 2).value)
'find if we have already created rows for the row keys, and if so return the row (else -1)
matrixRow = rowExistsInMatrix(rowKey1, rowKey2)
'find if we have already created a column for the column key, and if so return the row (else -1
matrixCol = colExistsInMatrix(colKey)
'Our matrix does not have a row with those row keys, so we must create one
If matrixRow = -1 Then
'increase the size of our matrix
matrixRowLength = matrixRowLength + 1
'get row that is not in use
matrixRow = matrixStartRow + matrixRowLength
'add the new keys to matrix
ActiveSheet.Cells(matrixRow, 1).value = rowKey1
ActiveSheet.Cells(matrixRow, 2).value = rowKey2
End If
'We don't have a column that matches the column key
If matrixCol = -1 Then
'increase size of matrix table
matrixColLength = matrixColLength + 1
'get column that is not in use
matrixCol = matrixStartCol + matrixColLength
'add new key to matrix
ActiveSheet.Cells(matrixStartRow, matrixCol).value = colKey
End If
'get the value to be placed in the matrix from column 4
value = CStr(ActiveSheet.Cells(dataRow, 4).value)
'place value
ActiveSheet.Cells(matrixRow, matrixCol).value = value
Next dataRow
End Function
'Checks to see if the key from the data table exists in our matrix table
'if it does, return the row in the matrix table
'else return -1
Private Function rowExistsInMatrix(dataKey1 As String, dataKey2 As String) As Long
Dim matrixRow As Long
Dim matrixKey1 As String, matrixKey2 As String
'loop through rows of matrix
For matrixRow = matrixStartRow To matrixStartRow + matrixRowLength
'get keys from matrix
matrixKey1 = CStr(ActiveSheet.Cells(matrixRow, 1).value)
matrixKey2 = CStr(ActiveSheet.Cells(matrixRow, 2).value)
'do the keys match
If dataKey1 = matrixKey1 And dataKey2 = matrixKey2 Then
rowExistsInMatrix = matrixRow
Exit Function
End If
Next matrixRow
rowExistsInMatrix = -1
End Function
'Same as rowExistsInMatrix but loops through column titles
Private Function colExistsInMatrix(dataKey As String) As Long
Dim matrixKey As String
Dim matrixCol As Integer
'loop through columns
For matrixCol = matrixStartCol To matrixStartCol + matrixColLength
matrixKey = CStr(ActiveSheet.Cells(matrixStartRow, matrixCol).value)
'does a key match
If matrixKey = dataKey Then
colExistsInMatrix = matrixCol
Exit Function
End If
Next matrixCol
colExistsInMatrix = -1
End Function
