View Matrix Data in a PivotTable?

[nickmac]

Hi all, any help with this would be hugely appreciated

I have a marco which does what I want, but it’s so slow that I think there must be a cleaver more efficient way to do the same thing. I’m hoping all you smart guys and gals will have some ideas!!

What I have is a resource allocation matrix (see image of a simplified version below). Within this for each resource for each project I forecast how many days I think they will be allocated to that project for each week.

However I really want to be able to report on all this data in PivotTables (again see example below).

Currently to do this I have a macro (shown below) that iterates through the matrix and creates a row in a new sheet for each cell that contains a value, and then I build the PivotTables off this data which is within a list format (see example List Data below).

This works, but it is painfully slow (currently the matrix is only about 50 x 100 and it takes a few minutes to update and almost kills my machine)

Any Ideas?! Maybe I'm going about this the whole wrong way - any suggestions most welcome.

Many thanks,
Nick


Original Data Sample - Matrix Format

Pivot Table Example - This is my end goal!!

This is the format I convert the matrix data into to be able to generate the PivotTables

This is the offensively slow Macro I created

Sub Update_PivotTable_Data()

' Request the User to confirm they want to continue
    Dim Msg, Style, Title, Response

    Msg = "Warning!" & vbCrLf & vbCrLf & "This update can take up to a couple of minutes." & vbCrLf & vbCrLf & "Do you want to continue?"     ' Define the message
    Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define the buttons
    Title = "Update Pivot Tables"    ' Define the title
    Response = MsgBox(Msg, Style, Title)    ' Display the pop-up message.
    
    If Response = vbNo Then
        Exit Sub
    End If

'Delete all the current PivotTable Data
    ThisWorkbook.Sheets("PivotTable Data").Select
    Rows("2:65536").Select
    Selection.Delete Shift:=xlUp
    Cells(1, 1).Select

    'Loop through all the rows in the Project Forecasts Table
    ThisWorkbook.Sheets("Project Forecasts").Select
        
    Dim iRow As Integer
    iRow = 4

    Dim iLastRow As Integer

    With ThisWorkbook.Sheets("Project Forecasts")
        On Error Resume Next
            Set LastRow = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        On Error GoTo 0
    End With
            
    iLastRow = LastRow.Row
    
    
    Dim iOutput_Row As Integer
    iOutput_Row = 2

        Do While Cells(iRow, 1) <> ""
            
            If Cells(iRow, 1) <> "* Project Timeline" Then
            
            ' Set all the static values for the row
            Dim sPerson As String
            Dim sTeam As String
            Dim sCustomer As String
            Dim sProject As String
            Dim sStatus As String
            Dim sRole As String
            Dim iRate As Integer

            sPerson = Cells(iRow, 1)
            sTeam = Cells(iRow, 2)
            sCustomer = Cells(iRow, 3)
            sProject = Cells(iRow, 4)
            sStatus = Cells(iRow, 5)
            sRole = Cells(iRow, 6)
            iRate = Cells(iRow, 7)
            
            'Iterate through all the columns
            Dim iCol As Integer
            Dim iLastCol As Integer
            
            iCol = 8
            
            With ThisWorkbook.Sheets("Project Forecasts")
                On Error Resume Next
                    Set LastCol = .Cells.Find(What:="*", After:=Cells(iRow + 1, 1), LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
                On Error GoTo 0
            End With
            
            iLastCol = LastCol.Column
                
                Do While iCol <= iLastCol

                    If Cells(iRow, iCol) <> "" Then
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 1) = sPerson
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 2) = sTeam
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 3) = sCustomer
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 4) = sProject
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 5) = sStatus
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 6) = sRole
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 7) = iRate
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 7).NumberFormat = "$#,##0"
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 8) = Cells(2, iCol)
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 8).NumberFormat = "m/d/yyyy"
                        ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 9) = Cells(1, iCol)
                        
                        If Cells(iRow, 1) = "* Fixed Billing Forecast" Then
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 10) = 0
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 11) = 0
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 11).NumberFormat = "0"
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 12) = Cells(iRow, iCol)
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 12).NumberFormat = "$#,##0"
                        Else
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 10) = Cells(iRow, iCol)
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 11) = Cells(iRow, iCol) / 5
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 11).NumberFormat = "0%"
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 12) = iRate * 7 * Cells(iRow, iCol)
                            ThisWorkbook.Sheets("PivotTable Data").Cells(iOutput_Row, 12).NumberFormat = "$#,##0"
                        End If
                        
                        iOutput_Row = iOutput_Row + 1
                    End If
            
                    'Move to the next column
                    iCol = iCol + 1
                Loop
            
            End If
            
            'Move to the next row
            iRow = iRow + 1
            Cells(1, 3).NumberFormat = "0%"
            Cells(1, 3) = (iRow) / (iLastRow + 1)
        Loop

    'Refresh the PivotTables
    Sheets("Revenue Forecast").PivotTables("Revenue_Forecast_PivotTable").PivotCache.Refresh
    Sheets("Team Utilization").PivotTables("Team_Utilization_PivotTable").PivotCache.Refresh

End Sub

 

[nickmac]

Anybody have any ideas?