Arranging Charts in a Grid

One effective way to present charts is to array them on a worksheet. You can lay them out manually, and even line them up nicely: by holding ALT while dragging and resizing charts, you constrain them to stick to the grid of cell boundaries.

However, if you have a lot of charts, this is tedious. I’ve arranged the charts in the view below using a VBA procedure.

Grid of Charts

The VBA procedure is not very complicated, and it lets you specify the height and width of each chart in cell units, as well as the top left cell under the first chart, and the number of rows and columns between adjacent charts.

Sub MakeGridOfCharts()
  ' Jon Peltier (3/19/2008, mod 10/03/2014)
  ' http://peltiertech.com/

  ' chart size - adjust as desired
  ' set one or both to zero to use dimensions of active chart
  '   (or first chart if no chart is active)
  Const nRowsTall As Long = 6
  Const nColsWide As Long = 3

  ' chart layout - adjust as desired
  Const nChartsPerRow As Long = 3
  Const nSkipRows As Long = 2
  Const nSkipCols As Long = 1
  Const nFirstRow As Long = 3
  Const nFirstCol As Long = 2

  Dim iChart As Long
  Dim chtob As ChartObject
  Dim dWidth As Double
  Dim dHeight As Double
  Dim rData As Range
  Dim dFirstChartTop As Double
  Dim dFirstChartLeft As Double
  Dim dRowsBetweenChart As Double
  Dim dColsBetweenChart As Double

  If ActiveSheet.ChartObjects.Count > 0 Then

    With ActiveSheet.Cells(nFirstRow, nFirstCol)
      If nRowsTall * nColsWide > 0 Then
        dWidth = nColsWide * .Width
        dHeight = nRowsTall * .Height
      Else
        If Not ActiveChart Is Nothing Then
          Set chtob = ActiveChart.Parent
        Else
          Set chtob = ActiveSheet.ChartObjects(1)
        End If
        dWidth = chtob.Width
        dHeight = chtob.Height
      End If

      dFirstChartLeft = .Left
      dFirstChartTop = .Top
      dRowsBetweenChart = nSkipRows * .Height
      dColsBetweenChart = nSkipCols * .Width
    End With

    For iChart = 1 To ActiveSheet.ChartObjects.Count

      Set chtob = ActiveSheet.ChartObjects(iChart)

      With chtob
        .Left = ((iChart - 1) Mod nChartsPerRow) * _
            (dWidth + dColsBetweenChart) + dFirstChartLeft
        .Top = Int((iChart - 1) / nChartsPerRow) * _
            (dHeight + dRowsBetweenChart) + dFirstChartTop
        .Width = dWidth
        .Height = dHeight
      End With

    Next

  End If

End Sub

 

Peltier Tech Charts for Excel

Comments

  1. Nice post Jon! I use this setup, often called ‘small multiples’ as coined by Edward Tufte, and this is definitely a helpful tip. I can confirm that doing this manually is tedious. Keep ’em coming!

  2. Tony –

    Thanks. I have another one in the works, which starts with a table, and produces one chart per row of data. But the site went down, actually it was suspended for an as-yet unexplained reason, and I spent too much time running around reinstating the site.

  3. I knew about snapping them to the grid, and I like the sound of a VBA routine, but I’ve recently found that shift-clicking on one embedded chart, or clicking on more than one, treats them like pictures, with all the facilities that implies. You can tell this has happened when the drag handles are white, not black. This means I can select a number of charts and type the size in manually in Format Object, and they’ll all have the same size. Then I can use the Draw toolbar to align and distribute them, just like Powerpoint objects or Autoshapes.

    (it also means they cut and paste into other applications as pictures and not embedded spreadsheets, which is a useful alternative to Copy Special)

    An annoying feature of Excel is that the actual plot area is less easy to control than the whole graph area, so the graph areas align but the plot areas, the bit the readers actually see and expect to align, do not. That can sometimes be mitigated by careful choice of axis label formats and legends.

  4. Derek – I use the shift-select trick a lot. You actually get a more accurate copy-paste than copying the chart area: when you copy the chart area and paste it, sometimes the pasted chart is a pixel wider and taller. Also, there’s a strange glitch when the window is at a lower resolution than 100%. Copy a chart at 50%, then paste it, and the pasted chart is half the size of the original. Shift-selecting before copying avoids this.

    When I shift-select a chart, then copy it and paste it into PowerPoint, I am still getting an embedded workbook. I just tested it before shooting my mouth off….

    And I have VBA solutions for the plot area size variations. In fact, here’s a semi-documented, semi-functional version:
    http://peltiertech.com/Excel/Zips/AlignChartDimensions.zip

  5. I’ve always used just used the Zoom and simple guide lines (INSERT > SHAPES > LINE). When you draw the lines you need to click twice, once for the first point and again for the second point. If after you have clicked the first point you hold down the ‘CNTRL’ key it fixes the second point orthoganally to the first point. If I want to be very accurate I’ll zoom right in. The maco is cool but I reckon I can line up 12 graphs like the example above in under 60 seconds with almost the same degree of accuracy.

  6. The chart arranging and resizing works great! Can this code be modified to do the same thing with a series of pictures of charts?

  7. Dan –

    Sure, it would go something like this (untested):

    Sub MakeGridOfShapes()
      ' http://peltiertech.com/
    
      ' shape size - adjust as desired
      Const nRowsTall As Long = 6
      Const nColsWide As Long = 3
    
      ' shape layout - adjust as desired
      Const nShapesPerRow As Long = 3
      Const nSkipRows As Long = 2
      Const nSkipCols As Long = 1
      Const nFirstRow As Long = 3
      Const nFirstCol As Long = 2
    
      Dim iShape As Long
      Dim shp As Shape
      Dim dWidth As Double
      Dim dHeight As Double
      Dim rData As Range
      Dim dFirstShapeTop As Double
      Dim dFirstShapeLeft As Double
      Dim dRowsBetweenShapes As Double
      Dim dColsBetweenShapes As Double
    
      With Worksheets("Shapes").Cells(1, 1)
        dWidth = nColsWide * .Width
        dHeight = nRowsTall * .Height
        dFirstShapeLeft = (nFirstCol - 1) * .Width
        dFirstShapeTop = (nFirstRow - 1) * .Height
        dRowsBetweenShapes = nSkipRows * .Height
        dColsBetweenShapes = nSkipCols * .Width
      End With
    
      For iShape = 1 To Worksheets("Shapes").Shapes.Count
    
        Set shp = Worksheets("Shapes").Shapes(iShape)
    
        With shp
          .Left = ((iShape - 1) Mod nShapesPerRow) * (dWidth + dColsBetweenShapes) + dFirstShapeLeft
          .Top = Int((iShape - 1) / nShapesPerRow) * (dHeight + dRowsBetweenShapes) + dFirstShapeTop
          .Width = dWidth
          .Height = dHeight
        End With
    
      Next
    
    End Sub
  8. Hi Jon,

    Thanks for this its works great! My only question is what if I just want to arrange my charts without changing the size, leaving them as they are? I tried to removing the dHeight and dWidth and the code failed

  9. Michael –

    I’ve modified the code so that you can have all charts sized by the active chart by setting either of the nRowsTall or nColsWide parameters to zero, and if no chart is selected it will use the first chart on the sheet.

  10. I see how the charts line up, but I need help modifying the code to fit my needs. I create a total of 12 charts. The first set should go down the first column and the second 6 should go down the second column. How can I modify the code from above to have charts 1-6 in the first column and charts 7-12 in the second column?

  11. Karen –

    It would go something like this:

    
      For iChart = 1 To 12
    
        Set chtob = Worksheets("Shapes").ChartObjects(iChart)
    
        With chtob
          .Left = Int((iChart - 1) /6) * (dWidth + dColsBetweenShapes) + dFirstShapeLeft
          .Top = ((iChart - 1) Mod 6) * (dHeight + dRowsBetweenShapes) + dFirstShapeTop
          .Width = dWidth
          .Height = dHeight
        End With
    
      Next
  12. Work great for me.
    I want to do one thing. How to copy a set of data in a column and paste it in the same chart grid?

  13. Abdulla –

    Do you want to turn a 1 column x N row data region into a M column x N/M row data region?

    The following code will do this. It will move the original cells into the new position, leaving the original position empty. Formulas and formatting will both be moved. If the new range isn’t large enough to completely contain all of the original cells, it will only move enough cells to fill the new range, and leave the unused cells in their original location. If the new range is too large, it will only move cells that are present in the original range and leave the rest of the new range blank.

    Sub MoveNx1rangetoRxCrange()
      Dim rSource As Range, rTarget As Range
      Dim nRowsSrc As Long, nRowsTgt As Long, nColsSrc As Long, nColsTgt As Long
      Dim rSrcPart As Range, rTgtPart As Range
      Dim iCol As Long
      
      On Error Resume Next
      Set rSource = Application.InputBox("Select original range (1-column-wide)", "Source Range", , , , , , 8)
      If rSource Is Nothing Then GoTo PleaseLeave
      Set rTarget = Application.InputBox("Select destination range (rows x columns)", "Target Range", , , , , , 8)
      If rTarget Is Nothing Then GoTo PleaseLeave
      On Error GoTo 0
      
      nColsSrc = rSource.Columns.Count
      If nColsSrc > 1 Then
        Set rSource = rSource.Columns(1)
        nColsSrc = rSource.Columns.Count
      End If
      nRowsSrc = rSource.Rows.Count
      
      nColsTgt = rTarget.Columns.Count
      nRowsTgt = rTarget.Rows.Count
      
      For iCol = 1 To nColsTgt
        Set rSrcPart = Nothing
        On Error Resume Next
        Set rSrcPart = Intersect(rSource, rSource.Resize(nRowsTgt).Offset(nRowsTgt * (iCol - 1)))
        If rSrcPart Is Nothing Then GoTo PleaseLeave
        Set rTgtPart = rTarget.Resize(rSrcPart.Rows.Count, 1).Offset(, iCol - 1)
        
        rSrcPart.Cut rTgtPart
      Next
      
      Application.CutCopyMode = False
    PleaseLeave:
      
    End Sub
  14. Jon
    Thanks a lot for your immediate response.
    sorry, i don’t made it clear. Actually i want to put the chart name (hyperlink) under all charts that were arranged in grid. to do this, i have all the names of charts written in a column. i only need to copy (no cut) each cell in that column and past it below the correspondence chart.
    i.e i made chart grid of 3 by 4, and have all the chart name in column A1:A12

    Char1 Chart2 Chart3
    cell A1 cell A2 cell A3

    and so on.
    I tried to copy range using offset but it only leaves on column.

  15. Jon
    I think you only need to modify the code to leave N columns and M rows in the selected target. to meet the chart size and position. is it doable?

  16. Jon
    Another thing, I’ve made a code to copy all charts in WB. however, I don’t want to copy charts from certain sheets. the following code doesn’t work:

    Sub CopyChrt()
    
            Dim cht As Excel.ChartObject
            Dim wss As Worksheet
    
            For Each Sheet In ActiveWorkbook.Worksheets
    
                Sheet.Select
                For Each cht In Sheet.ChartObjects
                If wss.Name <> "Template" And wss.Name <> "Master Monitor" Then
                    cht.Select
                    ActiveChart.ChartArea.Copy
                    Sheets("Master Monitor").Select
                    Range("A1").Select
                    ActiveSheet.Paste
                    End If
                Next
    
           Next Sheet
    
    End Sub
  17. Abdulla –

    I haven’t returned to your first question, but I see an issue with your second. You’ve declared a worksheet variable wss, but you’re using an undeclared variable Sheet in your loop. You should enter the line

    Option Explicit

    then go to Tools menu > Options, and on the Editor tab, check Require Variable Declaration. This forces you to declare every variable before you can use it.

    You also do not need to select the sheet or activate the chart before copying the chart, which will avoid screen flickering while the code is running. To avoid activating the target worksheet, paste the chart, then position the chart object

    Your code should look more like this:

    Sub CopyChrt()
    
      Dim cht As Excel.ChartObject
      Dim wss As Worksheet
    
      For Each wss In ActiveWorkbook.Worksheets
        If wss.Name <> "Template" And wss.Name <> "Master Monitor" Then
    
          For Each cht In wss.ChartObjects
            cht.Chart.ChartArea.Copy
            With Sheets("Master Monitor")
              .Paste
              .ChartObjects(.ChartObjects.Count).Left = .Range("A1").Left
              .ChartObjects(.ChartObjects.Count).Top = .Range("A1").Top
            End With
          Next cht
    
        End If
      Next wss
    
    End Sub

    Presumably you have code that selects cells other than A1 to align all the charts, unless of course, you’re using the code from this article to arrange the charts.

  18. Abdulla –

    In the next procedure, I will assume the labels are in column A. The labels will be placed under each chart and centered across the width of the chart. I use the chart object’s .TopLeftCell property to figure out which cell should contain the label. The code is mostly the same until near the end.

    Sub MakeGridOfChartsWithLabels()
      ' Jon Peltier (3/19/2008, mod 10/03/2014)
      ' http://peltiertech.com/
    
      ' chart size - adjust as desired
      ' set one or both to zero to use dimensions of active chart
      '   (or first chart if no chart is active)
      Const nRowsTall As Long = 6
      Const nColsWide As Long = 3
    
      ' chart layout - adjust as desired
      Const nChartsPerRow As Long = 3
      Const nSkipRows As Long = 2
      Const nSkipCols As Long = 1
      Const nFirstRow As Long = 3
      Const nFirstCol As Long = 3
    
      Dim iChart As Long
      Dim chtob As ChartObject
      Dim dWidth As Double
      Dim dHeight As Double
      Dim dFirstChartTop As Double
      Dim dFirstChartLeft As Double
      Dim dRowsBetweenChart As Double
      Dim dColsBetweenChart As Double
    
      If ActiveSheet.ChartObjects.Count > 0 Then
    
        With ActiveSheet.Cells(nFirstRow, nFirstCol)
          If nRowsTall * nColsWide > 0 Then
            dWidth = nColsWide * .Width
            dHeight = nRowsTall * .Height
          Else
            If Not ActiveChart Is Nothing Then
              Set chtob = ActiveChart.Parent
            Else
              Set chtob = ActiveSheet.ChartObjects(1)
            End If
            dWidth = chtob.Width
            dHeight = chtob.Height
          End If
    
          dFirstChartLeft = .Left
          dFirstChartTop = .Top
          dRowsBetweenChart = nSkipRows * .Height
          dColsBetweenChart = nSkipCols * .Width
        End With
    
        For iChart = 1 To ActiveSheet.ChartObjects.Count
    
          Set chtob = ActiveSheet.ChartObjects(iChart)
    
          With chtob
            .Left = ((iChart - 1) Mod nChartsPerRow) * _
                (dWidth + dColsBetweenChart) + dFirstChartLeft
            .Top = Int((iChart - 1) / nChartsPerRow) * _
                (dHeight + dRowsBetweenChart) + dFirstChartTop
            .Width = dWidth
            .Height = dHeight
          End With
    
          ' put labels from column 1 of active sheet into cells below each chart
          With ActiveSheet.Cells(chtob.TopLeftCell.Row + nRowsTall, chtob.TopLeftCell.Column)
            .Value = ActiveSheet.Cells(iChart, 1).Value
            .Resize(, nColsWide).HorizontalAlignment = xlCenterAcrossSelection
          End With
    
        Next
    
      End If
    
    End Sub
  19. The output looks like this:

    Grid of Charts with Labels

  20. Jon
    i’m trying to plot huge series of data using for next statement, however, I don’t know why the secondary axis is not being plotted by the following code!! is it an issue of using charts or chartobject add function??

    Sub IndividualPlots()

    Dim TF As Worksheet
    Dim OIL As Worksheet
    Dim WTR As Worksheet
    Dim TG As Worksheet
    Dim GL As Worksheet
    Dim RG As Worksheet
    Dim WC As Worksheet
    Dim MM As Worksheet
    Dim VRRStart As Worksheet

    Dim NewWs As Worksheet
    Dim cht As Chart
    Dim chtobj As ChartObject
    Dim Lastcol As Long
    Dim Currcol As Long

    Set TF = ThisWorkbook.Worksheets(“TF”)
    Set OIL = ThisWorkbook.Worksheets(“OIL”)
    Set WTR = ThisWorkbook.Worksheets(“WTR”)
    Set TG = ThisWorkbook.Worksheets(“TG”)
    Set GL = ThisWorkbook.Worksheets(“GL”)
    Set RG = ThisWorkbook.Worksheets(“RG”)
    Set WC = ThisWorkbook.Worksheets(“RG”)
    Set MM = ThisWorkbook.Worksheets(“Master Monitor”)
    Set VRRStart = ThisWorkbook.Worksheets(“VRRStart”)

    Application.ScreenUpdating = False

    ClrChts

    Lastcol = TF.Cells(5, Columns.Count).End(xlToLeft).Column

    For Currcol = 2 To Lastcol

    Set cht = ThisWorkbook.Charts.Add

    ‘VRRstart Plot
    With cht.SeriesCollection.NewSeries
    .Name = “=” & VRRStart.Name & “!R1C2”
    .Values = “=” & VRRStart.Name & “!R” & 7 & “C” & Currcol & “:R” & 8 & “C” & Currcol
    .XValues = “=” & VRRStart.Name & “!R” & 7 & “C1:R” & 8 & “C1”
    .Border.Color = RGB(0, 0, 0)
    .Format.Line.Weight = 3
    End With

    ‘OIL Plot
    With cht.SeriesCollection.NewSeries
    .Name = “=” & OIL.Name & “!R1C2”
    .Values = “=” & OIL.Name & “!R” & 6 & “C” & Currcol & “:R” & 96 & “C” & Currcol
    .XValues = “=” & OIL.Name & “!R” & 6 & “C1:R” & 96 & “C1”
    .Border.Color = RGB(153, 204, 0)
    End With

    ‘WTR Plot
    With cht.SeriesCollection.NewSeries
    .AxisGroup = 2
    .Name = “=” & WTR.Name & “!R1C2”
    .Values = “=” & WTR.Name & “!R” & 6 & “C” & Currcol & “:R” & 96 & “C” & Currcol
    .XValues = “=” & WTR.Name & “!R” & 6 & “C1:R” & 96 & “C1”
    .Border.Color = RGB(0, 0, 0)

    End With

    ‘TG Plot
    With cht.SeriesCollection.NewSeries
    .AxisGroup = 2
    .Name = “=” & TG.Name & “!R1C2”
    .Values = “=” & TG.Name & “!R” & 6 & “C” & Currcol & “:R” & 96 & “C” & Currcol
    .XValues = “=” & TG.Name & “!R” & 6 & “C1:R” & 96 & “C1”
    .Border.Color = RGB(255, 0, 0)
    End With

    ‘WC Plot
    With cht.SeriesCollection.NewSeries
    .Name = “=” & WC.Name & “!R1C2”
    .Values = “=” & WC.Name & “!R” & 6 & “C” & Currcol & “:R” & 96 & “C” & Currcol
    .XValues = “=” & WC.Name & “!R” & 6 & “C1:R” & 96 & “C1”
    .Border.Color = RGB(255, 153, 0)
    End With

    With cht
    .ChartType = xlXYScatterLines
    .Axes(xlCategory).TickLabels.NumberFormat = “m/d/yy”
    .HasTitle = True
    .ChartTitle.Text = TF.Cells(4, Currcol)
    .ChartTitle.Font.Size = 10
    .HasLegend = True
    .Legend.Position = xlLegendPositionBottom
    .Location Where:=xlLocationAsObject, Name:=MM.Name

    End With

    ‘.Axes(xlCategory).MinimumScaleIsAuto = False
    ‘.Axes(xlCategory).MinimumScale = 42248
    ‘.Axes(xlCategory).MaximumScaleIsAuto = False
    ‘.Axes(xlCategory).MaximumScale = 42338

    ‘.Axes(xlValue).MinimumScaleIsAuto = False
    ‘.Axes(xlValue).MinimumScale = 0
    ‘.Axes(xlValue).MaximumScaleIsAuto = False
    ‘.Axes(xlValue).MaximumScale = 860

    Next Currcol

  21. Jon
    I figured it out, but the problem it accept on series only to be on the secondary axis!!!

    Sub IndividualPlots()

    Dim TF As Worksheet
    Dim OIL As Worksheet
    Dim WTR As Worksheet
    Dim TG As Worksheet
    Dim GL As Worksheet
    Dim RG As Worksheet
    Dim WC As Worksheet
    Dim MM As Worksheet
    Dim VRRStart As Worksheet

    Dim NewWs As Worksheet
    Dim cht As Chart
    Dim myChtObj As ChartObject
    Dim Lastcol As Long
    Dim Currcol As Long

    Set TF = ThisWorkbook.Worksheets(“TF”)
    Set OIL = ThisWorkbook.Worksheets(“OIL”)
    Set WTR = ThisWorkbook.Worksheets(“WTR”)
    Set TG = ThisWorkbook.Worksheets(“TG”)
    Set GL = ThisWorkbook.Worksheets(“GL”)
    Set RG = ThisWorkbook.Worksheets(“RG”)
    Set WC = ThisWorkbook.Worksheets(“RG”)
    Set MM = ThisWorkbook.Worksheets(“Master Monitor”)
    Set VRRStart = ThisWorkbook.Worksheets(“VRRStart”)

    Application.ScreenUpdating = False

    ClrChts

    Lastcol = TF.Cells(5, Columns.Count).End(xlToLeft).Column

    For Currcol = 2 To Lastcol

    Set myChtObj = ActiveSheet.ChartObjects.Add _
    (Left:=250, Width:=375, Top:=75, Height:=225)

    With myChtObj.Chart

    .ChartType = xlXYScatterLines
    .Axes(xlCategory).TickLabels.NumberFormat = “m/d/yy”
    .HasTitle = True
    .ChartTitle.Text = TF.Cells(4, Currcol)
    .ChartTitle.Font.Size = 10
    .HasLegend = True
    .Legend.Position = xlLegendPositionBottom
    .Location Where:=xlLocationAsObject, Name:=MM.Name

    ‘VRRstart Plot
    With .SeriesCollection.NewSeries
    .Name = “=” & VRRStart.Name & “!R1C2”
    .Values = “=” & VRRStart.Name & “!R” & 7 & “C” & Currcol & “:R” & 8 & “C” & Currcol
    .XValues = “=” & VRRStart.Name & “!R” & 7 & “C1:R” & 8 & “C1”
    .Border.Color = RGB(0, 0, 0)
    .Format.Line.Weight = 3

    End With

    ‘OIL Plot
    With .SeriesCollection.NewSeries
    .Name = “=” & OIL.Name & “!R1C2”
    .Values = “=” & OIL.Name & “!R” & 6 & “C” & Currcol & “:R” & 96 & “C” & Currcol
    .XValues = “=” & OIL.Name & “!R” & 6 & “C1:R” & 96 & “C1”
    .Border.Color = RGB(0, 128, 0)
    End With

    ‘WTR Plot
    With .SeriesCollection.NewSeries
    .AxisGroup = xlSecondary
    .Name = “=” & WTR.Name & “!R1C2”
    .Values = “=” & WTR.Name & “!R” & 6 & “C” & Currcol & “:R” & 96 & “C” & Currcol
    .XValues = “=” & WTR.Name & “!R” & 6 & “C1:R” & 96 & “C1”
    .Border.Color = RGB(0, 0, 225)
    End With

    ‘TG Plot
    With .SeriesCollection.NewSeries
    .AxisGroup = xlSecondary
    .Name = “=” & TG.Name & “!R1C2”
    .Values = “=” & TG.Name & “!R” & 6 & “C” & Currcol & “:R” & 96 & “C” & Currcol
    .XValues = “=” & TG.Name & “!R” & 6 & “C1:R” & 96 & “C1”
    .Border.Color = RGB(255, 0, 0)
    End With

    ‘WC Plot
    With .SeriesCollection.NewSeries
    .Name = “=” & WC.Name & “!R1C2”
    .Values = “=” & WC.Name & “!R” & 6 & “C” & Currcol & “:R” & 96 & “C” & Currcol
    .XValues = “=” & WC.Name & “!R” & 6 & “C1:R” & 96 & “C1”
    .Border.Color = RGB(0, 204, 225)
    End With

    End With
    Next Currcol

    ‘Arrange charts in grid

    Chartgrid

    Application.ScreenUpdating = True
    End Sub

Speak Your Mind

*

Peltier Tech Charts for Excel 3.0