Create A Pivot Chart Using VBA Resulting In A Runtime 5 Error

Question

Im trying to create a pivot chart through VBA (So a button can create the pie chart based on dynamic values from a form)

My code is:

 Dim iRow As Long


    '//Find First Empty Row In Database
iRow = Sheets("search results").Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row

    Sheets("Custom Chart").visible = True
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Search Results!A3:AM" & iRow, Version:=xlPivotTableVersion14). _
        CreatePivotTable TableDestination:="Custom Chart!A1", TableName:="PivotTable6" _
        , DefaultVersion:=xlPivotTableVersion14
    Sheets("Custom Chart").Select
    Cells(1, 1).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Custom Chart!$A$1:$C$18")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 192
    ActiveSheet.Shapes("Chart 1").IncrementTop 15
    ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
        "PivotTable6").PivotFields("Ethnicity Of Child"), "Count of Ethnicity Of Child" _
        , xlCount
    With ActiveSheet.PivotTables("PivotTable6").PivotFields(Me.Dy4.Value)
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveChart.ChartType = xlPie
    ActiveChart.ApplyLayout (6)
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart Result"
    ActiveWorkbook.ShowPivotTableFieldList = False

My code fails on this line:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Search Results!A3:AM" & iRow, Version:=xlPivotTableVersion14). _
    CreatePivotTable TableDestination:="Custom Chart!A1", TableName:="PivotTable6" _
    , DefaultVersion:=xlPivotTableVersion14

Saying that a runtime 5 error has occurred. The only reason I can think of is that I'm trying to use cell references to define a range, I noticed that if you record creating a pivot chart, it uses ranges like Sheet1!R1C1, but I don't understand those references.

Any help would be appreciated.

Thanks in advance.

iRow is of type Long and you are trying to add it to a string. You need to replace `iRow` with `CStr(iRow)`. Also check out this topic http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select/10717999#10717999 . — DeanBDean, Jan 30 '14 at 04:35
@DeanBDean Unfortunately, your suggestion of using `CStr(iRow)` does not solve the issue. Also, elsewhere I define iRow as a long and use it in the same way without an issue. — LBPLC, Jan 30 '14 at 16:30
I believe your issue is on TableDestination:="Custom Chart!A1". When I replaced "Custom Chart!A1" with a range object I got past Runtime 5 error. Before the line where you create the pivot table, add `Dim pivotDest as Range`. Then in the next line add `Set pivotDest = ActiveWorkbook.Sheets("Custom Chart").Range("A1")`. Then replace `"Custom Chart!A1"` with `pivotDest` — DeanBDean, Jan 30 '14 at 20:58

score 0 · Accepted Answer · answered Jan 30 '14 at 21:54

I fixed the problem myself,

Heres the complete code for generating a chart off of a form with variables:

Private Sub Creat_Chart_Click()

Worksheets.Add().Name = "Custom Chart"

If Me.R_End.Value = "" Or _
Me.R_Start.Value = "" Or _
Me.Chart_List.Value = "" Or _
Me.Data_List.Value = "" Or _
Me.Dy2.Value = "" Or _
Me.Dy4.Value = "" Then

MsgBox "Information is missing from the form"

Exit Sub

End If




Dim ws As Worksheet

Set ws = Worksheets("database")

Sheets("Settings").Range("Start_Date").Value = Format(Me.R_Start.Value, "mm/dd/yyyy")
Sheets("Settings").Range("End_Date").Value = Format(Me.R_End.Value, "mm/dd/yyyy")

'Collect Start & End Dates
Dim dStartDate As Long
Dim dEndDate As Long
dStartDate = Sheets("Settings").Range("Start_Date").Value
dEndDate = Sheets("Settings").Range("End_Date").Value

ws.Activate

'On Error GoTo error_Sdate:

    RowNum = Application.WorksheetFunction.Match(dStartDate, Range("B1:B60000"), 0)
    ' MsgBox "Found " & Format(dStartDate, "dd/mm/yyyy") & " at row : " & RowNum

'On Error GoTo error_Edate:

    RowNumEnd = Application.WorksheetFunction.Match(dEndDate, Range("B1:B60000"), 1)
    ' MsgBox "Found " & Format(dEndDate, "dd/mm/yyyy") & " at row : " & RowNumEnd

GoTo J1

error_Sdate:

Dim msg As String

msg = "You entered " & Format(dStartDate, "dd/mm/yyyy") & " as your Start Date, but no referrals were made on that date"
msg = msg & vbCrLf & "Please enter a different date in the Start Date box"
MsgBox msg, , "Start Date Not Found"
Err.Clear
Exit Sub

error_Edate:
msg = "You entered " & Format(dEndDate, "dd/mm/yyyy") & " as your End Date, but no referrals were made on that date"
msg = msg & vbCrLf & "Please enter a different date in the End Date box"
MsgBox msg, , "End Date Not Found"
Err.Clear
Exit Sub


J1:

Dim CR_1 As Integer
Dim CR1 As Integer

'// Get Criteria From Form And Search Database Headers
If Me.Data_List.Value = "Display Variable By Agency Of Referrer" Then

CR1 = 3

End If

If Me.Data_List.Value = "Display Variable By Agency Of Allegee" Then

CR1 = 4

End If



Set ws = Worksheets("database")
Set ps = Worksheets("Search Results")

   ps.Range("A3:AM60000").Clear

'Dim RowNum As Variant
'Dim RowNumEnd As Variant

    For i = RowNum To RowNumEnd
        If ws.Cells(i, CR1).Value = Me.Dy2.Value Then
        ws.Range("A" & i & ":AM" & i).Copy

        ps.Activate
        'find first empty row in database
        emR = ps.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
        ps.Range("A" & emR & ":AM" & emR).PasteSpecial

    End If
    Next i


Dim wksSource As Worksheet
    Dim wksDest As Worksheet
    Dim rngSource As Range
    Dim rngDest As Range
    Dim LastRow As Long
    Dim LastCol As Long

    Set wksSource = Worksheets("Search Results")

    Set wksDest = Worksheets("Custom Chart")

    With wksSource
        LastRow = .Range("A2").End(xlDown).Row
        LastCol = .Range("A2").End(xlToRight).Column
        Set rngSource = .Range("A2", .Cells(LastRow, LastCol))
    End With

    Set rngDest = wksDest.Range("A1")


wksDest.Activate

'    If wksDest.PivotTables.count > 0 Then
'
'
'    wksDest.Range("A:Z").Delete
'
'
'    End If



       ActiveSheet.PivotTableWizard _
        SourceType:=xlDatabase, _
        SourceData:=rngSource, _
        TableDestination:=rngDest, _
        TableName:="Pivotinfo"

    With wksDest.PivotTables("Pivotinfo")
        .PivotFields(Me.Dy4.Value).Orientation = xlRowField
        .PivotFields(Me.Dy4.Value).Orientation = xlDataField
    End With

  Dim CC As Worksheet
  Dim CCR, CCC As Long

 Set CC = Sheets("Custom Chart")


  CCR = CC.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row
  CCC = CC.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Column

            Range("A1").Select
    ActiveWorkbook.Charts.Add
    ActiveChart.ChartType = xlPie
    ActiveChart.ApplyLayout (4)
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.SetElement (msoElementLegendRight)
    ActiveChart.ApplyDataLabels
    ActiveChart.SeriesCollection(1).DataLabels.Select
    Selection.ShowPercentage = True
    Selection.ShowCategoryName = False
    Selection.Separator = "" & Chr(10) & ""
    If CR1 = 3 Then

    ActiveChart.ChartTitle.Characters.Text = Me.Dy4.Value & " Referred By " & Me.Dy2.Value & _
    " Between The Dates " & Me.R_Start.Value & " & " & Me.R_End.Value

    End If

    If CR1 = 4 Then

    ActiveChart.ChartTitle.Characters.Text = Me.Dy4.Value & " Referred By " & Me.Dy2.Value & _
    " Between The Dates " & Me.R_Start.Value & " & " & Me.R_End.Value

    End If




    Application.DisplayAlerts = False
    Worksheets("Custom Chart").Delete
    Application.DisplayAlerts = True

End Sub

I got around the issue by deleting the custom chart sheet and re-creating it to get rid of the pivot table so I could create a new one with the same name. Not the tidiest method, but it works

Create A Pivot Chart Using VBA Resulting In A Runtime 5 Error

1 Answers1