VBA Macro to create Bar Chart(Image Included)

[XcelNoobster]

How would I create a VBA Macro that generates a bar chart from the following sample data in Sheet Name "Final Result"?

 

[RoryA]

You'll need a pivot chart. I suggest you start by recording a macro while you create it.

 

[rlv01]

One way is to use the macro recorder to record your actions as you manually create the bar chart.

 

[XcelNoobster]

You'll need a pivot chart. I suggest you start by recording a macro while you create it.

Okay so i tried recording the macro, but get errors in the macro whenever i try to re-run the macro. What if there is more data than the sample above?, etc

 

[rlv01]

How about posting the macro recorder VBA code?

 

[XcelNoobster]

The pivot chart is what i am looking for, but

How about posting the macro recorder VBA code?

Sub Record()
'
' Record Macro
'

'
    Windows("Book2").Activate
    ActiveCell.Offset(-13, -6).Range("A1:C7").Select
    ActiveCell.Offset(-12, -6).Range("A1").Activate
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R7C3", Version:=8).CreatePivotTable TableDestination:= _
        "Sheet2!R1C1", TableName:="PivotTable28", DefaultVersion:=8
    Sheets("Sheet2").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable28")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable28").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable28").RepeatAllLabels xlRepeatLabels
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=Range("Sheet2!$A$1:$C$18")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 192
    ActiveSheet.Shapes("Chart 1").IncrementTop 14.5
    With ActiveChart.PivotLayout.PivotTable.PivotFields("Order")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
        PivotTable.PivotFields("ITEM"), "Count of ITEM", xlCount
    Windows("SearchMacro.xlsm").Activate
End Sub

 

[rlv01]

After commenting out a few irrelevant lines, your recorder code appears to draw the chart you want.

Sub Record()
'
' Record Macro
'

'
    'Windows("Book2").Activate
    'ActiveCell.Offset(-13, -6).Range("A1:C7").Select
    'ActiveCell.Offset(-12, -6).Range("A1").Activate
    
   With ActiveSheet
   .Range("A1:C7").Select
   .Range("A1").Activate
   End With
    
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R7C3", Version:=8).CreatePivotTable TableDestination:= _
        "Sheet2!R1C1", TableName:="PivotTable28", DefaultVersion:=8
    Sheets("Sheet2").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable28")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable28").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable28").RepeatAllLabels xlRepeatLabels
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=Range("Sheet2!$A$1:$C$18")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 192
    ActiveSheet.Shapes("Chart 1").IncrementTop 14.5
    With ActiveChart.PivotLayout.PivotTable.PivotFields("Order")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
        PivotTable.PivotFields("ITEM"), "Count of ITEM", xlCount
    'Windows("SearchMacro.xlsm").Activate
End Sub

[ATTACH type="full"]93060[/ATTACH]