Consulting

Results 1 to 4 of 4

Thread: Excel VBA to create a series of new pivot tables

  1. #1
    VBAX Regular
    Joined
    Dec 2014
    Posts
    30
    Location

    Excel VBA to create a series of new pivot tables

    I have a time tracking table with 3 columns in a work sheet labeled "Template". Each tab of the workbook will be labeled in date format mm-dd-yy and the NewSheet sub below works well (it adds a new tab and labels it accordingly). As each new daily sheet is created - the table in columns B-D on the template get copied over to columns A:C on the new sheet (Time of day in fifteen " increments, Activity, and Hours as 0.25). Next what I want to do is create a pivot table off the new daily time tracking table to summarize the activities by hour. But I want each new pivot table to automatically pull from the new sheet (and not be pointing to a different table such as on the Template tab & also be created on the same new sheet rather than another new sheet). Without a dim function and a counter to keep Excel VBA from getting confused - I'm not sure this is possible; but not sure how to edit the code below (in macro5)...

    Grateful for any assistance! Let me know if there are questions.

    Thanks!

    Sub NewSheet()
        
        Application.ScreenUpdating = False
        Dim wshL As Worksheet
        Dim wshN As Worksheet
        Dim d As Date
        Set wshL = Worksheets(Worksheets.Count)
        d = DateValue(wshL.Name)
        Set wshN = Worksheets.Add(After:=wshL)
        wshN.Name = Format(d + 1, "mm-dd-yy")
        
        Sheets("Template").Select
        Columns("B:D").Select
        Selection.Copy
        wshN.Select
        ActiveSheet.Paste
        ActiveWindow.Zoom = 90
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        Range("A1").Select
        Application.ScreenUpdating = True
        
    End Sub
    Sub Macro5()
    '
    ' Macro5 Macro
    '
    
    
    
    
        Range("A1:C54").Select
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            "06-29-20!R1C1:R54C3", Version:=6).CreatePivotTable TableDestination:= _
            "06-29-20!R2C5", TableName:="PivotTable5", DefaultVersion:=6
        Sheets("06-29-20").Select
        Cells(2, 5).Select
        ActiveWorkbook.ShowPivotTableFieldList = True
        With ActiveSheet.PivotTables("PivotTable4").PivotFields( _
            "Daily Time Tracker - Activity")
            .Orientation = xlRowField
            .Position = 1
        End With
        ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
            "PivotTable4").PivotFields("Hours"), "Sum of Hours", xlSum
        ActiveWorkbook.ShowPivotTableFieldList = False
        With ActiveSheet.PivotTables("PivotTable5").PivotFields( _
            "Daily Time Tracker - Activity")
            .PivotItems("(blank)").Visible = False
        End With
        Range("F2:F10").Select
        Selection.Style = "Comma"
        Range("E2").Select
        ActiveSheet.PivotTables("PivotTable5").TableStyle2 = "PivotStyleMedium9"
        Range("F12").Select
    End Sub

  2. #2
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,194
    Location
    If I understand correctly

    BTW, you don't need to select things to use them


    Option Explicit
    
    
    Sub Macro5()
        Dim wsTodaysSheetName As String
        
        wsTodaysSheetName = Format(Now, "mm-dd-yy")
        
        Range("A1:C54").Select
    
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            wsTodaysSheetName & "!R1C1:R54C3", Version:=6).CreatePivotTable TableDestination:= _
            wsTodaysSheetName & "!R2C5", TableName:="PivotTable5", DefaultVersion:=6
        Sheets(wsTodaysSheetName).Select
        Cells(2, 5).Select
        ActiveWorkbook.ShowPivotTableFieldList = True
        With ActiveSheet.PivotTables("PivotTable4").PivotFields( _
            "Daily Time Tracker - Activity")
            .Orientation = xlRowField
            .Position = 1
        End With
    
        ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
            "PivotTable4").PivotFields("Hours"), "Sum of Hours", xlSum
        ActiveWorkbook.ShowPivotTableFieldList = False
        With ActiveSheet.PivotTables("PivotTable5").PivotFields( _
            "Daily Time Tracker - Activity")
            .PivotItems("(blank)").Visible = False
        End With
        Range("F2:F10").Select
        Selection.Style = "Comma"
        Range("E2").Select
        ActiveSheet.PivotTables("PivotTable5").TableStyle2 = "PivotStyleMedium9"
        Range("F12").Select
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul

    Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Expert
    Joined
    Sep 2016
    Posts
    775
    Location
    Sub test()
        Dim wshL As Worksheet
        Dim wshN As Worksheet
        Dim d As Date
        
        Set wshL = Worksheets(Worksheets.Count)
        d = DateValue(wshL.Name)
        
        wshL.Copy After:=wshL
        Set wshN = ActiveSheet
        wshN.Name = Format(d + 1, "mm-dd-yy")
        
        Worksheets("Template").Columns("B:D").Copy wshN.Range("A1")
    
        wshN.Range("E2").PivotTable.SourceData = _
            wshN.Range("A1").CurrentRegion.Address(, , xlR1C1, True)
        
    End Sub

  4. #4
    VBAX Regular
    Joined
    Dec 2014
    Posts
    30
    Location

    Thanks mana! That works great : )

    Quote Originally Posted by mana View Post
    Sub test()
        Dim wshL As Worksheet
        Dim wshN As Worksheet
        Dim d As Date
        
        Set wshL = Worksheets(Worksheets.Count)
        d = DateValue(wshL.Name)
        
        wshL.Copy After:=wshL
        Set wshN = ActiveSheet
        wshN.Name = Format(d + 1, "mm-dd-yy")
        
        Worksheets("Template").Columns("B:D").Copy wshN.Range("A1")
    
        wshN.Range("E2").PivotTable.SourceData = _
            wshN.Range("A1").CurrentRegion.Address(, , xlR1C1, True)
        
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •