Issue with Pivot Destination and dynamic range

[allExcell]

Hi All,

I need your help on the below code. The code I've written to create a pivot is working fine so far, but I need some help to modify it a bit, and this is where I'm stuck now.

Option Explicit
Sub testme1()

Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim iCol As Long
Dim RowFieldArray() As String
Dim DataFieldArray() As String
Dim wks As Worksheet
Dim PT As PivotTable
Dim Pf As PivotField
Dim vRowFields() As Variant
Dim vDataFields() As Variant
vRowFields = Array("A", "B", "C", "D")
 
Set wks = Worksheets("Sheet1")

With wks
.Activate
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'skipping columns A
LastCol = 286
 

ReDim DataFieldArray(26 To 286)
For iCol = 26 To 286
DataFieldArray(iCol) = .Cells(1, iCol).Value
Next iCol

.Parent.PivotCaches.Add(SourceType:=xlDatabase, _
[B]SourceData:=wks.Range("Contents")).CreatePivotTable _
TableDestination:=Sheets("Pivot").Range("A5"), _
[/B]TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
End With

With Sheets("Pivot")
.Activate
Range("A5").Select

.PivotTables("PivotTable1").AddFields RowFields:=vRowFields
 
Dim i As Integer
    Dim iFieldMax As Integer
     On Error Resume Next
     ' Find the number of PivotFields
    iFieldMax = ActiveSheet.PivotTables("PivotTable1").PivotFields.Count
     
     ' Loop through the fields in the Pivot
    For i = 1 To iFieldMax
         
        With ActiveSheet.PivotTables("PivotTable1").PivotFields(i)
             
             'Set subtotal calculation to nothing
            .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
             
        End With
         
    Next i
For iCol = 26 To 286
With .PivotTables(1).PivotFields(iCol)
.Orientation = xlDataField
.Function = xlSum
End With
Next iCol
With .PivotTables(1).DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables(1).ColumnGrand = False
 
End With
End Sub

Here I want to make the pivot range dynamic. I'm not able to make the source data dynamic. Please see below, this is what I'm using at present.

[B]SourceData:=wks.Range("Contents")).CreatePivotTable [/B]

Again, the Pivot destination has to be hard coded with something like

[B]TableDestination:=Sheets("Pivot").Range("A5"), [/B]

. Unfortunately, this one is throwing an error, saying "Run-time error '1004'. Application-defined or object-defined error." while selecting below lines of code.

.Parent.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:=wks.Range("Contents")).CreatePivotTable _
TableDestination:=Sheets("Pivot").Range("A5"), _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10

Any help would be appreciated.

Thanks in advance.

 

[allExcell]

Hi Jerry,
This code is checking in all 1000 rows with formula. I've value till row 48, and it should stop checking there as row 49 onwards it's all Blank "", with formula in them.
If we can make the code stop checking after there is no Value (row 48), it will definitely take lesser time. Now, it's taking around 16 min to create a pivot with 1000 rows, where row 49 onwards for all the Blank Cells (with no formula) it's appearing as (Blank) in pivot as there are no value.

Points to be noted:
# Cells Blank"", with no value but formula, Pivot is not printing the blank cells as (Blank).
# Cells absolute Blank, with no formula either Pivot is printing the blank cells as (Blank).

 

[Jerry Sullivan]

The code should work correctly if the formulas are evaluating to blank (nullstring or "").
I suspect that the formulas are evaluating to 1 or more space characters (" ").

If so, can those formulas be modified so the code works correctly? (it's also a better practice).

Please post an example formula.

 

[allExcell]

Hi Jerry,

Pleaese see a sample formula for your help:

=IFERROR(IF(MATCH($F19,Resource_Name,0),OFFSET('Resource Names'!$F$2,MATCH($F19,Resource_Name,0)-1,-1,1,1),""),"")

Please let me know if you need any more details.

 

[Jerry Sullivan]

That formula should return a blank if the match isn't found and it should work with the code.

Try this to confirm that you have blanks in B49:B1000...
In Cell A48 place the formula =LEN(B48)
then copy that formula down to A1001.

If the formula is returning blanks, you should get all 0's in the Cells in Column A except for A48 which should count the characters in your first cell with a non-blank value.

BTW, Offset() is a volatile function which means it recalculates anytime the worksheet calculates.
This could be contributing to the slow response.
Try instead...
=IFERROR(INDEX('Resource Names'!$E$2:$E$10000,MATCH($F19,Resource_Name,0)-1),"")

 

[allExcell]

Ok Jerry,

Let me check. I will get back to you soon.

 

[allExcell]

Hi Jerry,
Let me explain you the complexity involved in the formula first. Column A acts as a simple Margin, Column B has unique ID. Where as the Formula in Column D fetches its value based on listed values in column F. Let's say, column F has resource name, based on the name selected there- it matches the same name in the already defined List for the exact value/name and offsets the same with another corresponding valu and returns it in column D.

Let us assume it returns the "preferred location" for that resource. Once again, Column D has some set values in it's dropdown. This is to help the end user if he is already certain about the value he has to select.
Similarly, there are many interlinked formula and multiple pre defined list of values in the name manager.

So, like you said, if I insert "=LEN(B48)" in C48 I get 2, and I get 2 for Blank cells too (for blank cells with formula).
Changing in formula will not be too easy either, as the template has different owner. I was working on fixing issue for this template. earlier it had a manually created pivot, with so many weeks column in the Data field. Everytime we refresh the pivot some weeks go missing. So, manually arranging weeks column becomes tedious at times, so I thought of automating the Pivot creation. And thsi is how the entire probles started taking shape.

When I started realizing that the problem is going to get over, it came back with another blow with this formula I think.
Please let me know if there is anyway to attach a sample template.

 

[Jerry Sullivan]

This forum isn't setup to allow attachments.

You could upload your file to a hosting site like Box.com then post a link in this thread.

 

[allExcell]

Hi Jerry,

Please see below the link to a dummy document. This could throw some more light into the problem.
https://www.box.com/s/6o05zr1w4xdhujikpq6t

Please let me know if anymore input is needed.

 

[Jerry Sullivan]

In that example file, you have constants 1-1000 in the cells in column B12:B1011.
The code in Post #20 will correctly find that the first non-blank cell is B1011 and size the data source based on that.

You need to define which column or columns should be checked for the last non-blank cell.
The code could be modified to look at that column instead.

 

[allExcell]

Hi Jerry,

Rightly said. The code is now working fine. The only thing I need to do now is re-designing the existing template. Lots of brainstorming with lots of stakeholders for approval. Thanking you once again for your help. Getting a solution like this otherwise would have been next to impossible for me. We can consider this post as "solved" now.

Thanks for all your support.