Forum Discussion

Elbucki's avatar
Elbucki
Copper Contributor
Feb 25, 2025
Solved

VBA charting with two rows of labels

Hello, I have old VBA code that used to make graphs from this data look like this.   .ChartWizard Source:=Worksheets(strCalcSht).Range(Cells(grpRow - 1, colsStats), Cells(grpRow + num...
Charting
excel
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Feb 27, 2025

    Thanks! Here is a different approach:

    Sub CreateChartCorrect()
    Dim strResults As String
    Dim grpRow As Integer
    Dim colsStats As Integer
    Dim numGroupsThisSheet As Integer
    Dim colsStatsEnd As Integer
    Dim ws As Worksheet
    Dim ch As Chart

    strResults = "Results"
    grpRow = 2
    colsStats = 2 ' 1
    numGroupsThisSheet = 5
    colsStatsEnd = 5

    Set ws = Worksheets(strResults)
    Set ch = ws.ChartObjects.Add(100, 300, 500, 700).Chart

    With ch
        .SetSourceData Source:=ws.Range(ws.Cells(grpRow - 1, colsStats), ws.Cells(grpRow + numGroupsThisSheet, colsStatsEnd))

        .ChartType = xlLineMarkers
        .PlotBy = xlColumns

        ' I will leave it to you to generalize this
        .FullSeriesCollection(1).XValues = ws.Range(ws.Cells(grpRow + 1, colsStats - 1), ws.Cells(grpRow + numGroupsThisSheet, colsStats - 1))

        .HasLegend = True

        With .Axes(xlCategory)
            .HasTitle = True
            .AxisTitle.Caption = "Core Crimp Ht. (mm)"
        End With

        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Caption = "Resistance (m" & ChrW(937) & ")"
        End With

         '/// Format title.
         .HasTitle = True
         .ChartTitle.Caption = "Test Results - Current Cycling" & Chr(10) & "Average Current = " & Str(Round(currentAvg, 1)) & " Amps"
         With .ChartTitle.Font
            .Name = "Test"
            .FontStyle = "Bold"
            .Size = 12
            .Underline = xlUnderlineStyleSingle
         End With
    End With
End Sub

     

HansVogelaar's avatar
HansVogelaar
MVP
Feb 27, 2025

Could you attach a small sample workbook demonstrating the problem (without sensitive data), or if that is not possible, make it available through OneDrive, Google Drive, Dropbox or similar?

  • Elbucki's avatar
    Elbucki
    Copper Contributor
    Feb 27, 2025

    Hans,  

    I couldn't upload the file directly, here is a Google drive https://drive.google.com/file/d/1rb1smz7SQKz0jlTszhxU8IPI6Iw1R1-6/view?usp=sharingwith a single macro that creates the graph.  The desired graph can be found by changing the chart type like the last picture in the first post.  I just can't get the right arguments to do that in code, thanks.  

     

    Here's the macro code in case the macros are blocked.

    Sub CreateChartIncorrect()

    Dim strResults As String
    Dim strCalcSht As Integer
    Dim grpRow As Integer
    Dim colsStats As Integer
    Dim numGroupsThisSheet As Integer
    Dim colsStatsEnd As Integer
    
    strResults = "Results"
    strCalcSht = 1
    grpRow = 2
    colsStats = 1
    numGroupsThisSheet = 5
    colsStatsEnd = 5
    
    Dim ch
 '     Set ch = Worksheets(strResults).ChartObjects.Add(100, 300, 420, 500)
    Set ch = Worksheets(strResults).ChartObjects.Add(100, 300, 500, 700)
    
    
    With Worksheets(strResults).ChartObjects(1).Chart
         Sheets(strCalcSht).Select
         
         
         
        .ChartWizard Source:=Worksheets(strCalcSht).Range(Cells(grpRow - 1, colsStats), Cells(grpRow + numGroupsThisSheet, colsStatsEnd)), _
                gallery:=xlLine, PlotBy:=xlColumns, categorylabels:=1, serieslabels:=2, HasLegend:=True, _
                Title:="Test Results - Current Cycling" & Chr(10) & "Average Current = " & Str(Round(currentAvg, 1)) & " Amps", _
                categorytitle:="Core Crimp Ht. (mm)", valuetitle:="Resistance (m" + ChrW(937) + ")"
    
         Sheets(strResults).Select
         .ChartType = xlLineMarkers
            
         '/// Format title.
         With .ChartTitle.Font
            .Name = "Test"
            .FontStyle = "Bold"
            .Size = 12
            .Underline = xlUnderlineStyleSingle
         End With
    End With
End Sub

     

    • HansVogelaar's avatar
      HansVogelaar
      MVP
      Feb 27, 2025

      Thanks! Here is a different approach:

      Sub CreateChartCorrect()
    Dim strResults As String
    Dim grpRow As Integer
    Dim colsStats As Integer
    Dim numGroupsThisSheet As Integer
    Dim colsStatsEnd As Integer
    Dim ws As Worksheet
    Dim ch As Chart

    strResults = "Results"
    grpRow = 2
    colsStats = 2 ' 1
    numGroupsThisSheet = 5
    colsStatsEnd = 5

    Set ws = Worksheets(strResults)
    Set ch = ws.ChartObjects.Add(100, 300, 500, 700).Chart

    With ch
        .SetSourceData Source:=ws.Range(ws.Cells(grpRow - 1, colsStats), ws.Cells(grpRow + numGroupsThisSheet, colsStatsEnd))

        .ChartType = xlLineMarkers
        .PlotBy = xlColumns

        ' I will leave it to you to generalize this
        .FullSeriesCollection(1).XValues = ws.Range(ws.Cells(grpRow + 1, colsStats - 1), ws.Cells(grpRow + numGroupsThisSheet, colsStats - 1))

        .HasLegend = True

        With .Axes(xlCategory)
            .HasTitle = True
            .AxisTitle.Caption = "Core Crimp Ht. (mm)"
        End With

        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Caption = "Resistance (m" & ChrW(937) & ")"
        End With

         '/// Format title.
         .HasTitle = True
         .ChartTitle.Caption = "Test Results - Current Cycling" & Chr(10) & "Average Current = " & Str(Round(currentAvg, 1)) & " Amps"
         With .ChartTitle.Font
            .Name = "Test"
            .FontStyle = "Bold"
            .Size = 12
            .Underline = xlUnderlineStyleSingle
         End With
    End With
End Sub

       

      • Elbucki's avatar
        Elbucki
        Copper Contributor
        Feb 27, 2025

        That works perfectly, thank you very much.

Resources