Create pivot Tabel Using dynamic range.

jdixon12

New Member
Joined
Oct 6, 2006
Messages
8
I have a macro that selects a range based on the contents of a cell. That part works. What I need is the macro to then use that range to create a pivot table. I can't figure out what to put in to tell the pivot table part to use the cells that have been selected. (I then want it to go an and select the next region that starts with the same cell contents)

Here is as close as I can get:

Code:
    Dim cell As Range
    Dim Data As Range
    For Each cell In Range("A1:A1500")
    If cell = "Code:  LUNCH" Then
    cell.Select
    ActiveCell.CurrentRegion.Select
    Set Data = ActiveRange
    
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "=Data").CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Employee Name")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Code:  LUNCH"), "Count of Code:  LUNCH", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    Application.CommandBars("PivotTable").Visible = False
    End If
    Set Data = Nothing
    Next cell
    End Sub

It doesn't like this part
Code:
Set Data = ActiveRange
but I don't know what it should be and couldn't find it with a search (most of this has been written by what I found in the forum here :)

Thank you in advance for the help :biggrin:
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Try changing

Set Data = ActiveRange

to

Set Data = Selection

...I don't think there is an ActiveRange property in Excel VBA.

By the way, it looks like you are looping through 1500 cells and, each time you see Code:= LUNCH, you are creating a pivot table on the same range. Is that what you intended to do?

Denis
 
Upvote 0
Almost there :)

Thank You :biggrin:

I changed the ActiveRange to Selection... which I figured was probably wrong. Now it gets past that part; however, now it stops at:

Code:
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"=Data").CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable1", DefaultVersion:=xlPivotTableVersion10

... with "Runtime error '1004'" It says that a reference is invalid... any thoughts.

I want it to use the selection to create the pivot table on a new sheet.
 
Upvote 0
Try changing
Code:
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ 
"=Data").CreatePivotTable TableDestination:="", TableName:= _ 
        "PivotTable1", DefaultVersion:=xlPivotTableVersion10
To
Code:
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ 
Data).CreatePivotTable TableDestination:="", TableName:= _ 
        "PivotTable1", DefaultVersion:=xlPivotTableVersion10

Here is another way to create the pivot table -- it makes referencing simpler. It will work for Excel 2000 and above:
Code:
Sub MakePivots()
    Dim WSD As Worksheet, WSD2 As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim cell As Range
    Dim Data As Range
    Set WSD = ActiveSheet
    For Each cell In Range("A1:A1500")
        If cell = "Code:  LUNCH" Then
            cell.Select
            ActiveCell.CurrentRegion.Select
            Set Data = Selection
            Set WSD2 = Worksheets.Add 'create a new sheet for the PT
            
            'set up a Pivot Cache
            Set PTCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, Data)
            Set PT = PTCache.CreatePivotTable(WSD2.Range("A3"), "PivotTable1")
            PT.ManualUpdate = True
            
            WSD2.Activate
        
            With PT.PivotFields("Employee Name")
                .Orientation = xlRowField
                .Position = 1
            End With
            PT.AddDataField ActiveSheet.PivotTables( _
                "PivotTable1").PivotFields("Code:  LUNCH"), "Count of Code:  LUNCH", xlCount
            ActiveWorkbook.ShowPivotTableFieldList = False
            Application.CommandBars("PivotTable").Visible = False
            PT.ManualUpdate = False
        End If
        Set Data = Nothing
        WSD.Activate 'return to the main sheet
    Next cell
End Sub

Denis
 
Upvote 0
Almost There :)

Thank you very much for all of your help. I think it is almost there. I used both ways and both have an error. I believe I know what is causing the error on the first one. It creates a pivot table for the first selectino and then gives a runtime error referencing
Code:
cell.Select
I believe this is because the original range is still selected. It sounds like I just need to add a bit about unselecting just before the "next cell" part. Unfortunately I haven't been able to figure out how to do this.

Again, thank you so much. This is one of three worksheets that need a very similiar macro and this is a great foundation for the other two :biggrin:
 
Upvote 0
Glad to help. Try commenting out the offending line:

Change
cell.Select
to
'cell.Select

Because it is immediately followed by ActiveCell.CurrentRegion.Select, the first command should be redundant.

But I repeat my first question: Why are you creating so many pivot tables off the same data range? As far as I can tell they will all be identical, and the only trigger for creating one will be the cell contents (same in all cases).
...Unless, of course, the cell contents are a heading. If so, you will only create the PT once, but there are quicker ways to find the heading without using a loop. You could, for example, just use a Find command. It's easy to record the code and use that in your routine.

Denis
 
Upvote 0
Just had another thought. Cell is likely to be a reserved work in VBA, given that there is a Cells collection. This causes problems if you use Cell as a variable, so try this instead:
Code:
Sub MakePivots()
    Dim WSD As Worksheet, WSD2 As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim c As Range
    Dim Data As Range
    Set WSD = ActiveSheet
    For Each c In Range("A1:A1500")
        If c.Value = "Code:  LUNCH" Then
            c.CurrentRegion.Select
            Set Data = Selection
            Set WSD2 = Worksheets.Add 'create a new sheet for the PT
           
            'set up a Pivot Cache
            Set PTCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, Data)
            Set PT = PTCache.CreatePivotTable(WSD2.Range("A3"), "PivotTable1")
            PT.ManualUpdate = True
           
            WSD2.Activate
       
            With PT.PivotFields("Employee Name")
                .Orientation = xlRowField
                .Position = 1
            End With
            PT.AddDataField ActiveSheet.PivotTables( _
                "PivotTable1").PivotFields("Code:  LUNCH"), "Count of Code:  LUNCH", xlCount
            ActiveWorkbook.ShowPivotTableFieldList = False
            Application.CommandBars("PivotTable").Visible = False
            PT.ManualUpdate = False
        End If
        Set Data = Nothing
        Exit For 'no need to keep looking: pivot is constructed
    Next c
End Sub
Denis
 
Upvote 0
It just dawned on my what I haven't explained. I have a report that exports to exel and has each day of the week with lunchs all on the same worksheet. There isn't a way to split them out on seperate worksheets, though there are several blank rows between days. The report shows each of the employees and their lunch times for each day. what I am trying to do is have the macro find the first instance of "Code: Lunch" and create a pivot tabel to show how many people go to lunch during each timeframe. Then It should find the next instance of "Code: Lunch" on the same worksheet and create a pivot table. This way I would end up with 7 Pivot tables, one for each day of the week and each on a seperate tab.

what it is doing now is creating the first pivot table and then when it loops back through it gives a runtime error on cell.select.

Does this help?
 
Upvote 0
OK, try using a Find command instead. I tried Code: LUNCH and it failed, but LUNCH by itself was OK.
I have created a For ... Next loop to account for 7 days, so this shoudl do the trick. See how you go...
Code:
Sub MakePivots()
    Dim WSD As Worksheet, WSD2 As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim c As Range
    Dim i As Integer
    Dim Data As Range
    Set WSD = ActiveSheet
    Range("A1").Select
    For i = 1 To 7
    Cells.Find(What:="LUNCH", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
            
         c.CurrentRegion.Select
         Set Data = Selection
         Set WSD2 = Worksheets.Add 'create a new sheet for the PT
        
         'set up a Pivot Cache
         Set PTCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, Data)
         Set PT = PTCache.CreatePivotTable(WSD2.Range("A3"), "PivotTable1")
         PT.ManualUpdate = True
        
         WSD2.Activate
    
         With PT.PivotFields("Employee Name")
             .Orientation = xlRowField
             .Position = 1
         End With
         PT.AddDataField ActiveSheet.PivotTables( _
             "PivotTable1").PivotFields("Code:  LUNCH"), "Count of Code:  LUNCH", xlCount
         ActiveWorkbook.ShowPivotTableFieldList = False
         Application.CommandBars("PivotTable").Visible = False
         PT.ManualUpdate = False
        
        Set Data = Nothing
        WSD.Activate
    Next i
End Sub
Denis
 
Upvote 0
Object variable or with block variable not set

It skips to the second "code: lunch" in the "A" column and then gives the runtime error

Code:
Object variable or with block variable not set

when I go into debug it is highlighting

Code:
c.CurrentRegion.Select

It seems like this is just above my knowledge level but will be very beneificial if we can get it figured out. (and it will has been a good learning experience for me :) )[/quote]
 
Upvote 0

Forum statistics

Threads
1,214,651
Messages
6,120,744
Members
448,989
Latest member
mariah3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top