I have seen this asked multiple times but none of the solutions offered have solved my issue- I continue to get this error even though I have used the same code in multiple other applications with no errors. I have included the code below and hope that someone can spot the issue that I am just failing to see!
Sub CreateJobsGraphsPrincipalCategory()
'Initial variables
Dim wbnew As Workbook
Dim wsnew As Worksheet
Dim Datasheet As Worksheet
'Dataset variables
Dim BeneficiaryList(0 To 10000), PrincipalList(0 To 10000), CheckRange As String
Dim NumberRows, RowNumber As Long
Dim Isduplicate, intPrincipal, intStatus, intLineItem As Integer
Dim PrincipalColumn, StatusColumn, LineItemColumn As String
Dim PrincipalRange, StatusRange, LineItemRange As String
Dim PrincipalNumber, BeneficiaryNumber As Integer
'New PivotChart variables
Dim objPivotcache As PivotCache
Dim objPivotTable As PivotTable
Dim bcount As Integer
Dim ProsperatorArray(1 To 25) As String
Dim BusinessNameColumn, BeneficiaryName, BeneficiaryNameFind As String
Dim objPivot As PivotTable, objPivotRange As Range, objChart As Chart
Dim LastColumnNumber As Double
'Setup workbooks
Dim CurrentWorkbook As Workbook
Dim SaveToWorkbook As Workbook
'Stop screen updating and calculating furing processing
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Select overall datasheet
Worksheets("DataforPrincipals").Activate
Set Datasheet = ActiveSheet
'Find last column. Start from column 30 as it will not be less than this
LastColumnNumber = 30
LastColumnValue = Datasheet.Cells(1, LastColumnNumber)
While LastColumnValue <> ""
LastColumnNumber = LastColumnNumber + 1
LastColumnValue = Datasheet.Cells(1, LastColumnNumber)
Wend
LastColumnNumber = LastColumnNumber - 1
'LastColumnValue = Datasheet.Cells(1, LastColumnNumber)
LastColumnValue = Getcolumn(LastColumnNumber)
'get last row
LastRowNumber = 1
LastRowRange = "A" & LastRowNumber
LastRowValue = Datasheet.Cells(LastRowNumber, 1)
While LastRowValue <> ""
LastRowNumber = LastRowNumber + 1
LastRowRange = "A" & LastRowNumber
LastRowValue = Datasheet.Cells(LastRowNumber, 1)
Wend
LastRowNumber = LastRowNumber - 1
PivotRange = "A" & "1" & ":" & LastColumnValue & LastRowNumber
'Creating Pivot cache
Set objPivotcache = ActiveWorkbook.PivotCaches.Create(xlDatabase, "'DataforPrincipals'!" & PivotRange)
'Create Arrays for Beneficiaries and Principals
'Get Columns for filtering and checking
PrincipalColumn = FindDataColumnHeading("Principal")
' StatusColumn = FindDataColumnHeading("Status")
LineItemColumn = FindDataColumnHeading("Line Item")
BusinessNameColumn = FindDataColumnHeading("Business Name")
RowNumber = 2
NumberRows = 0
CheckRange = BusinessNameColumn & RowNumber
PrincipalNumber = 1
BeneficiaryNumber = 1
While Datasheet.Range(CheckRange) <> ""
NumberRows = NumberRows + 1
PrincipalRange = PrincipalColumn & RowNumber
' StatusRange = StatusColumn & RowNumber
LineItemRange = LineItemColumn & RowNumber
' If Datasheet.Range(StatusRange) = "Active" Then
If Datasheet.Range(LineItemRange) = "Turnover" Then
BeneficiaryList(BeneficiaryNumber) = Datasheet.Range(CheckRange)
BeneficiaryNumber = BeneficiaryNumber + 1
'Check if principal is in the dataset yet
If RowNumber = 2 Then
PrincipalList(PrincipalNumber) = UCase(Trim(Datasheet.Range(PrincipalRange)))
Else
PrincipalNumber = PrincipalNumber + 1
Isduplicate = 0
For i = 1 To PrincipalNumber
If PrincipalList(i) = UCase(Trim(Datasheet.Range(PrincipalRange))) Then
Isduplicate = 1
End If
Next i
If Isduplicate = 0 Then
PrincipalList(PrincipalNumber) = UCase(Trim(Datasheet.Range(PrincipalRange)))
Else
PrincipalNumber = PrincipalNumber - 1
End If
End If
End If
' End If
RowNumber = RowNumber + 1
CheckRange = BusinessNameColumn & RowNumber
Wend
Set CurrentWorkbook = Application.ActiveWorkbook
' Set wbnew = Workbooks.Add
'wbnew = ActiveWorkbook.Name
CurrentWorkbook.Activate
For i = 1 To PrincipalNumber
PrincipalNameFind = PrincipalList(i)
If PrincipalList(i) <> PrincipalList(i - 1) Then
If InStr(1, PrincipalList(i), "(") > 0 Then
PrincipalName = Left(PrincipalList(i), 25) & 0
Else
PrincipalName = Left(PrincipalList(i), 25)
End If
'Adding new worksheet
Worksheets("DataforPrincipals").Activate
Set wsnew = Worksheets.Add
wsnew.Name = PrincipalName & "JC"
Worksheets(PrincipalName & "JC").Activate
'Creating Pivot table
Set objPivotTable = objPivotcache.CreatePivotTable(wsnew.Range("A1"))
'set Beneficiary row field
'Setting Fields
With objPivotTable
With .PivotFields("Principal")
.Orientation = xlPageField
.CurrentPage = "ALL"
.ClearAllFilters
.CurrentPage = PrincipalNameFind
End With
'set data fields (PI TO, TO)
With .PivotFields("Category")
.Orientation = xlRowField
End With
.AddDataField .PivotFields("PI Total Staff"), "PI Jobs", xlSum
.AddDataField .PivotFields("Current Total Staff"), "Current Jobs", xlSum
.AddDataField .PivotFields("Job Growth"), "Job Growth ", xlSum
With .PivotFields("PI Jobs")
.NumberFormat = "#"
End With
With .PivotFields("Current Jobs")
.NumberFormat = "#"
End With
With .PivotFields("Job Growth ")
.NumberFormat = "#%"
End With
End With
' Access the new PivotTable from the sheet's PivotTables collection.
Set objPivot = ActiveSheet.PivotTables(1)
' Add a new chart sheet.
Set objChart = Charts.Add
' Create a Range object that contains
' all of the PivotTable data, except the page fields.
Set objPivotRange = objPivot.TableRange1
' Specify the PivotTable data as the chart's source data.
With objChart
.ShowAllFieldButtons = False
.SetSourceData objPivotRange
.ChartType = xlColumnClustered
.ApplyLayout (5)
With .ChartTitle
.Text = " Employment Growth performance per Category"
End With
.SeriesCollection(1).HasDataLabels = False
.SeriesCollection(2).HasDataLabels = False
.SeriesCollection(3).HasDataLabels = False
.Axes(xlCategory).HasTitle = False
.DataTable.Select
End With
If InStr(1, PrincipalList(i), "(") > 0 Then
PrincipalName = Left(PrincipalList(i), 25) & 0
Else
PrincipalName = Left(PrincipalList(i), 25)
End If
ActiveSheet.Name = PrincipalName & " JCG"
If Sheetslist = "" Then
Sheetslist = PrincipalName & " JCG"
Else
Sheetslist = Sheetslist & ", " & PrincipalName & " JOBS"
End If
End If
Next i
'Copy to new file
Set CurrentWorkbook = Application.ActiveWorkbook
DirectoryName = Sheets("Run Automated").Range("B1")
For i = 1 To PrincipalNumber
If PrincipalList(i) <> PrincipalList(i - 1) Then
With Worksheets("Run Automated")
NameFileInitial = .Range("B2") & " " & PrincipalList(i) & ".xlsm"
End With
If InStr(1, PrincipalList(i), "(") > 0 Then
PrincipalName = Left(PrincipalList(i), 25) & 0
Else
PrincipalName = Left(PrincipalList(i), 25)
End If
'Set sheets to save
sheet1save = PrincipalName & " TC"
sheet2save = PrincipalName & " TOC"
sheet7save = PrincipalName & "JC"
sheet8save = PrincipalName & " JCG"
Set CurrentWorkbook = Application.ActiveWorkbook
Namefile = DirectoryName & "\" & NameFileInitial
Workbooks.Open Namefile
Set SaveToWorkbook = Application.ActiveWorkbook
Application.DisplayAlerts = False
CurrentWorkbook.Sheets(Array(sheet1save, sheet2save, sheet7save, sheet8save)).Move Before:=SaveToWorkbook.Sheets(1)
ActiveWorkbook.Close (True)
Application.DisplayAlerts = True
CurrentWorkbook.Activate
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub