none
Create "pivot"-like overview of tasks still open RRS feed

  • Question

  • All

    I need to create some kind of "PivotTable" with an overview of tasks still to be done.  Below is an easy example of what I need.

    The first PivotTable is a real one. It shows the estimated amount of tasks which will be ended in a specific month.  As you see, John has 5 tasks in total. He will end 3 tasks in January, 1 task in February and 1 task in March.

    What I need, is the second table which I now filled in manually: it shows the estimated amount of open tasks at end of the month.  So John has 5 tasks in total and will end 3 tasks in January. this means there are 2 open tasks in January. He will end 1 task in February, meaning there is 1 open task. He will end 1 task in March, meaning there are no more open tasks.

    Is there a simple way to create such overview? A VBA-solution is allowed.


    • Edited by kvhoof Friday, February 12, 2016 2:36 PM
    Friday, February 12, 2016 2:29 PM

Answers

  • I found a solution.

    Private Sub CreateReport()
    Dim strPivot As String
    Dim Pivot As PivotTable
    Dim RightColumn As Integer
    Dim rs As ADODB.Recordset
    Dim X As Integer
    Dim intTemp As Integer
    On Error GoTo errhandler
    
    strPivot = ActiveCell.PivotTable.Name
    Set Pivot = ActiveSheet.PivotTables(strPivot)
    With Pivot
        With .TableRange1
            RightColumn = .Columns.Count + .Column - 1
            If LCase(ActiveCell.Offset(-1, RightColumn - 1)) <> "grand total" Then
                MsgBox ("There is no Grand Total column on row level. This column is mandatory. Be sure you activated the first cell of the pivot table with active data. ")
                Exit Sub
            End If
            RightColumn = RightColumn - ActiveCell.Column
        End With
    End With
    
    If LCase(ActiveCell.Offset(-1, RightColumn)) <> "grand total" Then
        MsgBox ("There is no Grand Total column on row level. This column is mandatory. Be sure you activated the first cell of the pivot table with active data. ")
        Exit Sub
    End If
    
    
    Set rs = New ADODB.Recordset
    rs.Fields.Append ActiveCell.Offset(-1, 0), adVarChar, adFldKeyColumn
    With rs
        For X = 1 To RightColumn
            .Fields.Append ActiveCell.Offset(-1, X), adInteger, , adFldMayBeNull
        Next
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With
    
    While ActiveCell.Value <> ""
        With rs
            .AddNew
            .Fields(0).Value = ActiveCell.Offset(0, 0)
            intTemp = 0
            For X = 1 To RightColumn - 1
                .Fields(X).Value = ActiveCell.Offset(0, RightColumn) - ActiveCell.Offset(0, X) - intTemp
                intTemp = intTemp + ActiveCell.Offset(0, X)
            Next
            .Fields(rs.Fields.Count - 1).Value = ActiveCell.Offset(0, RightColumn)
            ActiveCell.Offset(1, 0).Activate
        End With
    Wend
    
    ActiveCell.Offset(2, 0).Activate
    rs.MoveFirst
    ActiveCell.CopyFromRecordset rs
    
    Exit Sub
    
    errhandler:
        MsgBox ("Please be sure you selected the Pivottable's first cell with active data.")
        
    End Sub
    

    • Marked as answer by kvhoof Friday, February 12, 2016 3:20 PM
    • Edited by kvhoof Friday, February 12, 2016 3:33 PM
    Friday, February 12, 2016 3:18 PM

All replies

  • I found a solution.

    Private Sub CreateReport()
    Dim strPivot As String
    Dim Pivot As PivotTable
    Dim RightColumn As Integer
    Dim rs As ADODB.Recordset
    Dim X As Integer
    Dim intTemp As Integer
    On Error GoTo errhandler
    
    strPivot = ActiveCell.PivotTable.Name
    Set Pivot = ActiveSheet.PivotTables(strPivot)
    With Pivot
        With .TableRange1
            RightColumn = .Columns.Count + .Column - 1
            If LCase(ActiveCell.Offset(-1, RightColumn - 1)) <> "grand total" Then
                MsgBox ("There is no Grand Total column on row level. This column is mandatory. Be sure you activated the first cell of the pivot table with active data. ")
                Exit Sub
            End If
            RightColumn = RightColumn - ActiveCell.Column
        End With
    End With
    
    If LCase(ActiveCell.Offset(-1, RightColumn)) <> "grand total" Then
        MsgBox ("There is no Grand Total column on row level. This column is mandatory. Be sure you activated the first cell of the pivot table with active data. ")
        Exit Sub
    End If
    
    
    Set rs = New ADODB.Recordset
    rs.Fields.Append ActiveCell.Offset(-1, 0), adVarChar, adFldKeyColumn
    With rs
        For X = 1 To RightColumn
            .Fields.Append ActiveCell.Offset(-1, X), adInteger, , adFldMayBeNull
        Next
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With
    
    While ActiveCell.Value <> ""
        With rs
            .AddNew
            .Fields(0).Value = ActiveCell.Offset(0, 0)
            intTemp = 0
            For X = 1 To RightColumn - 1
                .Fields(X).Value = ActiveCell.Offset(0, RightColumn) - ActiveCell.Offset(0, X) - intTemp
                intTemp = intTemp + ActiveCell.Offset(0, X)
            Next
            .Fields(rs.Fields.Count - 1).Value = ActiveCell.Offset(0, RightColumn)
            ActiveCell.Offset(1, 0).Activate
        End With
    Wend
    
    ActiveCell.Offset(2, 0).Activate
    rs.MoveFirst
    ActiveCell.CopyFromRecordset rs
    
    Exit Sub
    
    errhandler:
        MsgBox ("Please be sure you selected the Pivottable's first cell with active data.")
        
    End Sub
    

    • Marked as answer by kvhoof Friday, February 12, 2016 3:20 PM
    • Edited by kvhoof Friday, February 12, 2016 3:33 PM
    Friday, February 12, 2016 3:18 PM
  • Hi kvhoof,

    Thanks for sharing.

    If you have any other issues, please feel free to post in this forum.

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Monday, February 15, 2016 2:47 AM