VBA code breaks if lines are in excess of 40,000 approx

[tezza]

Hi, again...

I have a code that runs very well if there are say, 15,000 lines in the worksheet but fails at higher number of rows

The code stops and highlights the code at this part of the code:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    SrcData, Version:=6).CreatePivotTable TableDestination:= _
    "Hours!R1C1", TableName:="Staff_Hours", DefaultVersion:=6

A pop up box shows at in the image

The code in that section of the VBA is:

Sheets("Sheet1").Select
'ScrData =
SrcData = ActiveSheet.Name & "!" & Range("A1", Range("A1").SpecialCells(xlLastCell)).Address(ReferenceStyle:=xlR1C1)
Sheets.Add(After:=ActiveSheet).Name = "Hours"
Sheets("Hours").Select

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    SrcData, Version:=6).CreatePivotTable TableDestination:= _
    "Hours!R1C1", TableName:="Staff_Hours", DefaultVersion:=6
Set pvt = ActiveSheet.PivotTables("Staff_Hours")
'Add item to filter
pvt.PivotFields("Staff Staff Pay Group").Orientation = xlPageField
pvt.PivotFields("Chargeable Rate Sheet").Orientation = xlPageField
'Add item to the Row Labels
    pvt.PivotFields("Staff First Name Staff Last Name").Orientation = xlRowField
'Add items to Values
pfName = "Hours"
    pvt.AddDataField pvt.PivotFields("Rounded"), pfName, xlSum
pfName = "BasicP"
    pvt.AddDataField pvt.PivotFields("Basic"), pfName, xlSum
pfName = "DomP"
    pvt.AddDataField pvt.PivotFields("Dom_care"), pfName, xlSum
pfName = "Spt"
    pvt.AddDataField pvt.PivotFields("Specialist Task"), pfName, xlSum
pfName = "WeekendP"
    pvt.AddDataField pvt.PivotFields("Weekend"), pfName, xlSum
pfName = "OfficeP"
    pvt.AddDataField pvt.PivotFields("Office"), pfName, xlSum
pfName = "On-Call"
    pvt.AddDataField pvt.PivotFields("DC/On-Call"), pfName, xlSum
pfName = "TT"
    pvt.AddDataField pvt.PivotFields("Travel Time"), pfName, xlSum
pvt.CalculatedFields.Add Name:="All Staff Mileage", Formula:="=Staff Mileage + Community Mileage"
pfName = "All_staff_mileage"
    pvt.AddDataField pvt.PivotFields("All Staff Mileage"), pfName, xlSum
 
    
    
Sheets.Add(After:=ActiveSheet).Name = "Mileage"
Sheets("Mileage").Select
      
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    SrcData, Version:=6).CreatePivotTable TableDestination:= _
    "Mileage!R1C1", TableName:="Client_Mileage", DefaultVersion:=6
Set pvt = ActiveSheet.PivotTables("Client_Mileage")
pvt.PivotFields("Chargeable Rate Sheet").Orientation = xlPageField
'Add item to the Row Labels
    pvt.PivotFields("Client First Name Client Last Name").Orientation = xlRowField
'Add items to Values
    pfName = "Miles"
    pvt.AddDataField pvt.PivotFields("Mileage"), pfName, xlSum
    pfName = "Comm_Miles"
    pvt.AddDataField pvt.PivotFields("Community Mileage"), pfName, xlSum

End Sub

 

[Domenic]

It's likely due to the method you're using in order to define your source range. With xlCellTypeLastCell, the last cell will only reset when you save your workbook. So your defined range may be including blank columns (and rows). Instead, try using the LastRow() and LastCol() functions in the following link...

Home | Ron de Bruin Excel Automation

Welcome to https://www.rondebruin.nl

www.rondebruin.nl

Hope this helps!

 

[Alex Blakenburg]

You could give this a try:

Replace this:

SrcData = ActiveSheet.Name & "!" & Range("A1", Range("A1").SpecialCells(xlLastCell)).Address(ReferenceStyle:=xlR1C1)

With this:

Dim SrcData As Range
Set SrcData = ActiveSheet.Range("A1").CurrentRegion

 

[tezza]

I'll give these a try when I'm back in work, thank you.

In the meantime, I recorded a new macro to just create a pivot table and compared the codes.

The new code had version 8 instead of 6, so I changed it to 8 and it seemed to work after I reloaded it. I only tried once thought, so don't know if doing multiple runs will work.

 

[Alex Blakenburg]

Your error message indicates that SrcData is including columns that don't have any headings. As Dominic pointed out xlCellTypeLastCell can cause this since it is the same as hitting ctrl+End in the spreadsheet.
After you get the error, try it. Do ctrl+end and see if it takes you past where the Data finishes. Or in the immediate window (ctrl+g in vba if you can't see it) and type ?SrcData including the question mark and hit enter. Then validate the address it shows you.

 

[tezza]

Some Cols have data in every cell, which part of the code chooses which Col to check?

The VBA was already in place so I'm just trying to adapt it.

 

[Alex Blakenburg]

To use the xlUp method, select any column that will always have data on all rows.
Unless your data occasionally has an entire row or column blank or extra columns with no headings, current region should work for you.

 

[tezza]

To use the xlUp method, select any column that will always have data on all rows.
Unless your data occasionally has an entire row or column blank or extra columns with no headings, current region should work for you.

Hi, I've just altered the code and whilst it does run (which is great) it seems to take about 1 second to do a page of 40 rows, so I had to stop the 44,000 sheet as it's taking too long.

Any ideas?

 

[Alex Blakenburg]

Can you provide an XL2BB of some sample data that we can run your code against and try to reproduce your issue at our end ?

 

[tezza]

Can you provide an XL2BB of some sample data that we can run your code against and try to reproduce your issue at our end ?

I can but it will take some time to setup a sample sheet as it's all personal information.