0

I have a macro that exists in an empty workbook. Every day data will be pasted in and the macro will then be ran. One part of the macro is that it updates the data source in a pivot table and refreshes. When I paste the data in and run the macro it throws the error message of a blank column heading. The dynamic element doesn't seem to be working correctly.

Function PivotTable()
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim StartPoint As range
Dim DataRange As range
Dim PivotName As String
Dim NewRange As String

'Set Variables Equal to Data Sheet and Pivot Sheet
 Set Data_sht = ThisWorkbook.Worksheets("Sheet1")
 Set Pivot_sht = ThisWorkbook.Worksheets("Pivot Table")

'Enter in Pivot Table Name
 PivotName = "PivotTable"

'Dynamically Retrieve Range Address of Data
 Set StartPoint = Data_sht.range("A1")
 Set DataRange = Data_sht.range(StartPoint, StartPoint.SpecialCells(xlLastCell))

NewRange = Data_sht.Name & "!" & _
DataRange.Address(ReferenceStyle:=xlR1C1)

'Make sure every column in data set has a heading and is not blank (error prevention)
  If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
MsgBox "One of your data columns has a blank heading." & vbNewLine _
  & "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
End If

'Change Pivot Table Data Source Range Address
 Pivot_sht.PivotTables(PivotName).ChangePivotCache _
ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=NewRange)

'Ensure Pivot Table is Refreshed
 Pivot_sht.PivotTables(PivotName).RefreshTable


 End Function
2
  • Your CountBlank check should have End if the clause is triggered, since I'm guessing you don't want to execute the rest of the code if there's a blank column header. Have you done Debug.Print to ensure the DataRange and the NewRange string are being set correctly? Commented Sep 1, 2017 at 14:37
  • It looks to me that when I run it it works originally. However when I then paste new data in, the ranee doesn't update correctly. The amount of columns has become less however it keeps selecting columns that are now blank Commented Sep 1, 2017 at 15:15

1 Answer 1

3

I've never used .SpecialCells(xlLastCell) before, so I'm not sure how reliable it is. It's possible that when you paste new data in, it still considers old columns because there is some formatting present. This could happen if when you delete your old data, you simply use the delete key rather than physically deleting the cells. Here's how I would suggest going about getting the new range:

Sub PivotTable()
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim lrow_data As Long
Dim lcol_data As Long
Dim DataRange As Range
Dim PivotName As String

'Set Variables Equal to Data Sheet and Pivot Sheet
Set Data_sht = ThisWorkbook.Worksheets("Sheet1")
Set Pivot_sht = ThisWorkbook.Worksheets("Pivot Table")

'Enter in Pivot Table Name
PivotName = "PivotTable"

'Dynamically Retrieve Range Address of Data
With Data_sht
    lrow_data = .Cells(Cells.Rows.Count, 1).End(xlUp).Row 'gets last row
    lcol_data = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column 'gets last column
    Set DataRange = .Range(.Cells(1, 1), .Cells(lrow_data, lcol_data))
End With

'Make sure every column in data set has a heading and is not blank (error prevention)
If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
    MsgBox "One of your data columns has a blank heading." & vbNewLine _
    & "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
    End
End If

'Change Pivot Table Data Source Range Address
Pivot_sht.PivotTables(PivotName).ChangePivotCache _
ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=DataRange)

'Ensure Pivot Table is Refreshed
 Pivot_sht.PivotTables(PivotName).RefreshTable

 End Sub

NOTE: this answer assumes that your data is always pasted beginning in A1, and that there will be a value in column A for each line in your data set.

Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.