Here's the full VBA with comments added:
Private strChartTitle As String Private strChartType As String Private iEndRowForSrcData As String Private iCntValCols As Integer 'counts number of value cols in Source worksheet Private Sub Generate_Table_And_Chart_Click() Application.DisplayAlerts = False Generate_Table_Chart_Worksheets 'create the Table and if they're not already there Generate_Table 'produce the table of triplets from the crosstab Generate_Bubble_Chart 'we don't fully understand why, but this has to be Generate_Bubble_Chart 'called twice to make the chart produce properly ThisWorkbook.Save End Sub Private Sub Generate_Table_Chart_Worksheets() Dim iShtToDelete As Integer Dim StrWkshtNameArr(1 To 2) As String StrWkshtNameArr(1) = "Chart" StrWkshtNameArr(2) = "Table" 'ensure that second sheet is called Update, in case anyone changes it If ThisWorkbook.Worksheets(2).Name <> "Update" Then ThisWorkbook.Worksheets(2).Name = "Update" End If iShtToDelete = 3 'delete table and chart worksheets (if they exist) For iWkShtCnt = iShtToDelete To ThisWorkbook.Worksheets.Count ThisWorkbook.Worksheets(iShtToDelete).Delete Next iWkShtCnt 'Add table and chart worksheets For iWkShtCnt = 1 To 2 Worksheets.Add(after:=ThisWorkbook.Worksheets("Update")).Name = StrWkshtNameArr(iWkShtCnt) Next iWkShtCnt End Sub Private Sub Generate_Table() Dim StrColHdgsArr(1 To 3) As String Dim iPosToAddHdg As Integer Dim iXAxisDataPointCount As Integer Dim iColForAgeHdg_SrcWksht As Integer Dim iStartColForValHdg_SrcWksht As Integer 'clear chart worksheet to allow for updates from source sheet ThisWorkbook.Worksheets("Table").Cells.Clear On Error Resume Next strChartType = "Bbl_Chrt" Set ChartObject = Worksheets("Chart").ChartObjects(strChartType) If Not ChartObject Is Nothing Then ThisWorkbook.Worksheets("Chart").ChartObjects(strChartType).Delete End If strChartTitle = "Chart Title?" 'Will always be 3 headings! StrColHdgsArr(1) = "XTitle" StrColHdgsArr(2) = "YTitle" StrColHdgsArr(3) = "Value" iEndRowForSrcData = ThisWorkbook.Worksheets("Source").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'do not copy Grand Total row from Source worksheet If Not IsNumeric(ThisWorkbook.Worksheets("Source").Cells(iEndRowForSrcData, 1)) Then iEndRowForSrcData = iEndRowForSrcData - 1 End If For iColCnt = 1 To ThisWorkbook.Worksheets("Source").Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column If LCase(Trim(ThisWorkbook.Worksheets("Source").Cells(1, iColCnt))) = "age" Then iColForAgeHdg_SrcWksht = iColCnt End If Next iColCnt iStartColForValHdg_SrcWksht = iColForAgeHdg_SrcWksht + 1 iPosToAddHdg = 1 iXAxisDataPointCount = 1 iCntValCols = 0 'count no of value cols as measurement could vary e.g., hr of day = 24hrs (24 cols), days of week (5 cols), etc For iColCnt = 1 To ThisWorkbook.Worksheets("Source").Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column If IsNumeric(ThisWorkbook.Worksheets("Source").Cells(1, iColCnt)) Then 'only count numerical vals iCntValCols = iCntValCols + 1 End If Next iColCnt With ThisWorkbook.Worksheets("Table") For iColCnt = 1 To iCntValCols For iColHdgCnt = LBound(StrColHdgsArr) To UBound(StrColHdgsArr) .Cells(1, iPosToAddHdg) = StrColHdgsArr(iColHdgCnt) For iRowCnt = 2 To iEndRowForSrcData If iColHdgCnt = 1 Then 'hour .Cells(iRowCnt, iPosToAddHdg) = iXAxisDataPointCount .Cells(1, iPosToAddHdg).Interior.ColorIndex = 34 .Cells(iRowCnt, iPosToAddHdg).Interior.ColorIndex = 34 End If If iColHdgCnt = 2 Then 'age .Cells(iRowCnt, iPosToAddHdg) = ThisWorkbook.Worksheets("Source").Cells(iRowCnt, iColForAgeHdg_SrcWksht) .Cells(1, iPosToAddHdg).Interior.ColorIndex = 40 .Cells(iRowCnt, iPosToAddHdg).Interior.ColorIndex = 40 End If If iColHdgCnt = 3 Then 'val .Cells(iRowCnt, iPosToAddHdg) = ThisWorkbook.Worksheets("Source").Cells(iRowCnt, iStartColForValHdg_SrcWksht) .Cells(1, iPosToAddHdg).Interior.ColorIndex = 36 .Cells(iRowCnt, iPosToAddHdg).Interior.ColorIndex = 36 End If Next iRowCnt iPosToAddHdg = iPosToAddHdg + 1 Next iColHdgCnt iXAxisDataPointCount = iXAxisDataPointCount + 1 iStartColForValHdg_SrcWksht = iStartColForValHdg_SrcWksht + 1 Next iColCnt End With Erase StrColHdgsArr End Sub Private Sub Generate_Bubble_Chart() Dim iChartTop As Integer Dim iChartLeft As Integer Dim iChartHeight As Integer Dim iChartWidth As Integer Dim iSeriesXValCol As Integer Dim strSeriesXValCol As String Dim iSeriesYValCol As Integer Dim strSeriesYValCol As String Dim iSeriesDataPtCol As Integer Dim strSeriesDataPtCol As String Dim iSeriesCnt As Integer Dim iEndColForDataPoint As Integer iChartTop = 10 iChartLeft = 5 iChartHeight = 400 iChartWidth = 560 ThisWorkbook.Worksheets("Chart").Select On Error Resume Next Set ChartObject = ActiveWorkbook.Worksheets("Chart").ChartObjects(strChartType) If ChartObject Is Nothing Then Set ChartObject = ActiveWorkbook.Worksheets("Chart").ChartObjects.Add(Left:=iChartLeft, Width:=iChartWidth, Top:=iChartTop, Height:=iChartHeight) ChartObject.Name = strChartType End If ThisWorkbook.Worksheets("Chart").ChartObjects(strChartType).Select If Not ActiveChart Is Nothing Then With ActiveChart .HasTitle = True .HasLegend = False .ChartArea.Interior.ColorIndex = 19 .PlotArea.Interior.Color = vbWhite .PlotArea.Border.LineStyle = xlNone .PlotArea.Width = iChartWidth * 0.88 .PlotArea.Height = iChartHeight * 0.84 .PlotArea.Top = 40 .PlotArea.Left = 40 .ChartTitle.Text = strChartTitle .ChartTitle.Font.Size = 11 .ChartTitle.Font.Bold = True .ChartTitle.Font.Name = "Tahoma" 'iCntValCols series to add (3 variables per series) 'therefore iEndColForDataPoint = 3 * iCntValCols iEndColForDataPoint = 3 * iCntValCols iSeriesCnt = 1 For iColCnt = 1 To iEndColForDataPoint Step 3 iSeriesXValCol = iColCnt iSeriesYValCol = iColCnt + 1 iSeriesDataPtCol = iColCnt + 2 'convert iSeriesXValCol, iSeriesYValCol, and iSeriesDataPtCol to their string equivalents to allow range object of chart to be defined If iSeriesXValCol > 26 Then strSeriesXValCol = Chr(Int((iSeriesXValCol - 1) / 26) + 64) & Chr(((iSeriesXValCol - 1) Mod 26) + 65) Else strSeriesXValCol = Chr(iSeriesXValCol + 64) End If If iSeriesYValCol > 26 Then strSeriesYValCol = Chr(Int((iSeriesYValCol - 1) / 26) + 64) & Chr(((iSeriesYValCol - 1) Mod 26) + 65) Else strSeriesYValCol = Chr(iSeriesYValCol + 64) End If If iSeriesDataPtCol > 26 Then strSeriesDataPtCol = Chr(Int((iSeriesDataPtCol - 1) / 26) + 64) & Chr(((iSeriesDataPtCol - 1) Mod 26) + 65) Else strSeriesDataPtCol = Chr(iSeriesDataPtCol + 64) End If .SeriesCollection.NewSeries .ChartType = xlBubble .SeriesCollection(iSeriesCnt).XValues = Sheets("Table").Range("$" & strSeriesXValCol & "$2:$" & strSeriesXValCol & iEndRowForSrcData) .SeriesCollection(iSeriesCnt).Values = Sheets("Table").Range("$" & strSeriesYValCol & "$2:$" & strSeriesYValCol & iEndRowForSrcData) .SeriesCollection(iSeriesCnt).BubbleSizes = "=Table!R2C" & iSeriesDataPtCol & ":R70C" & iSeriesDataPtCol .SeriesCollection(iSeriesCnt).Border.ColorIndex = 1 .SeriesCollection(iSeriesCnt).Interior.ColorIndex = 34 .ChartGroups(1).BubbleScale = 15 iSeriesCnt = iSeriesCnt + 1 Next iColCnt With .Axes(xlValue, xlPrimary) .HasTitle = True .AxisTitle.Text = "YTitle?" .AxisTitle.Font.Size = 10 .AxisTitle.Font.Bold = False .AxisTitle.Font.Name = "Tahoma" .AxisTitle.Font.ColorIndex = 1 .AxisTitle.Left = 1 .AxisTitle.Orientation = xlHorizontal .MajorGridlines.Border.ColorIndex = 15 End With With .Axes(xlValue, xlPrimary) .MinimumScale = 0 .MaximumScale = 100 .MajorUnit = 10 End With With .Axes(xlCategory).TickLabels .Font.Size = 10 .Font.Name = "Tahoma" .Font.Bold = False .Font.ColorIndex = 56 .Orientation = 0 End With With .Axes(xlCategory) .HasTitle = True .AxisTitle.Text = "XTitle?" .AxisTitle.Font.Size = 10 .AxisTitle.Font.Bold = False .AxisTitle.Font.Name = "Tahoma" .AxisTitle.Font.ColorIndex = 1 .MinimumScale = 0 .MaximumScale = iCntValCols + 1 'add one so that right hand side of bubble is not cut off .MajorUnit = 1 End With With .Axes(xlSecondary).TickLabels .Font.Size = 10 .Font.Name = "Tahoma" .Font.Bold = False .Font.ColorIndex = 56 End With End With Else MsgBox "Please select a chart and try again.", _ vbExclamation, "No Chart Selected" End If End Sub