Option Explicit 
 
Sub xlAlignCharts() 
     
    Dim Ans         As VbMsgBoxResult 
    Dim ChartNums() As Long 
    Dim HorzInc     As Long 
    Dim I           As Long 
    Dim J           As Long 
    Dim Left        As Long 
    Dim NumCharts   As Long 
    Dim NumCols     As Long 
    Dim NumRows     As Long 
    Dim StartChart  As String 
    Dim StartHeight As Long 
    Dim StartLeft   As Long 
    Dim StartNum    As Long 
    Dim StartTop    As Long 
    Dim StartWidth  As Long 
    Dim Top         As Long 
    Dim VertInc     As Long 
    Dim xlShape     As Shape 
     '
     '           determine # of charts on this sheet
     '
    NumCharts = ActiveSheet.ChartObjects.Count 
    If NumCharts < 1 Then 
        MsgBox "no charts on this sheet.", vbCritical + vbOKOnly 
        Exit Sub 
    End If 
    If NumCharts = 1 Then 
        MsgBox "only 1 chart on this sheet.", vbCritical + vbOKOnly 
        Exit Sub 
    End If 
    ReDim ChartNums(NumCharts) 
     '
     '           gather up data on active chart
     '
    On Error GoTo Error_NoActiveChart 
SetStartChart: 
    StartChart = Trim(Right(ActiveChart.Name, Len(ActiveChart.Name) - Len(ActiveSheet.Name))) 
    StartHeight = ActiveSheet.Shapes(StartChart).Height 
    StartLeft = ActiveSheet.Shapes(StartChart).Left 
    StartTop = ActiveSheet.Shapes(StartChart).Top 
    StartWidth = ActiveSheet.Shapes(StartChart).Width 
    HorzInc = StartWidth / 20 
    VertInc = HorzInc 
     '
     '           build chart number sequence array
     '
    StartNum = 0 
    For I = 1 To NumCharts 
        If ActiveSheet.ChartObjects(I).Name = StartChart Then 
            StartNum = I 
            Exit For 
        End If 
    Next I 
    J = StartNum - 1 
    For I = 1 To NumCharts 
        J = J + 1 
        If J > NumCharts Then J = 1 
        ChartNums(I) = J 
    Next I 
     '
     '           get # rows and # cols
     '
    On Error GoTo Error_BadInput 
GetRowCol: 
    NumRows = InputBox("# of chart rows?") 
    NumCols = InputBox("# of chart cols?") 
    If NumRows * NumCols < NumCharts Then 
        Ans = MsgBox("based on input only " & NumRows * NumCols & " charts will" & vbCrLf & _ 
        "resized and moved.  OK", vbQuestion + vbYesNoCancel) 
        If Ans = vbCancel Then Exit Sub 
        If Ans = vbNo Then GoTo GetRowCol 
    End If 
     '
     '           resize and move
     '
    Top = StartTop 
    Left = StartLeft + StartWidth + HorzInc 
    NumCharts = 0 
    For I = 1 To NumRows 
        For J = 1 To NumCols 
            NumCharts = NumCharts + 1 
            If NumCharts > ActiveSheet.ChartObjects.Count Then Exit Sub 
            Set xlShape = ActiveSheet.Shapes(ActiveSheet.ChartObjects(ChartNums(NumCharts)).Name) 
            If xlShape.Name <> StartChart Then 
                xlShape.Top = Top 
                xlShape.Left = Left 
                xlShape.Height = StartHeight 
                xlShape.Width = StartWidth 
                Left = Left + StartWidth + HorzInc 
            End If 
        Next J 
        Top = Top + StartHeight + VertInc 
        Left = StartLeft 
    Next I 
    Exit Sub 
Error_NoActiveChart: 
    MsgBox "No active chart.  Select a chart to be in upper left " & vbCrLf & _ 
    "corner of 'chart grid' and rerun procedure.", vbCritical + vbOKOnly 
    Exit Sub 
Error_BadInput: 
     
End Sub