Module for automatic spreadsheet formatting and chart generation in Excel.

modCharting.vbs

Public Sub ChartAll()
    On Error GoTo Handler
    Worksheets.Add before:=Worksheets(1)
    Sheets(1).Name = "Summary"
    Sheets(1).Activate
    'Application.ScreenUpdating = False
    ' Fix issue with invalid data type to MakeArray
    Dim strSheetName As String
    ' end fix
    
    Dim myChtObj As ChartObject
    Dim rngChtData As Range
    Dim rngChtXVal As Range
    Dim strRange As Variant
    Dim iColumn As Long
    Dim i, y As Long
    Dim intColStart As Integer
    Dim lastrow As Integer
    Dim lastcolumn As Integer
    Dim ws As Variant
    Dim arrSpreadSheet
    
    
    For i = 2 To Worksheets.Count
        Set ws = Sheets(i)
        ws.Activate
        lastrow = ws.Cells(Rows.Count, "a").End(xlUp).Row
        lastcolumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
      
        'Colour Title and Totals
        With Range(Cells(1, 1), Cells(1, lastcolumn))
            .Interior.ColorIndex = 3
            .Interior.Pattern = xlSolid
            .Font.ColorIndex = 2
            .Font.Bold = True
        End With
        With Range(Cells(lastrow, 1), Cells(lastrow, lastcolumn))
            .Interior.ColorIndex = 3
            .Interior.Pattern = xlSolid
            .Font.ColorIndex = 2
            .Font.Bold = True
        End With
        ws.Columns.AutoFit
        
        'Freeze title row
        ws.Cells(2, 1).Activate
        With ActiveWindow
            .FreezePanes = False
            .FreezePanes = True
        End With
           
        ' define chart data
        'Set rngChtData = ws.Range(Cells(1, 1), Cells(lastrow - 1, lastcolumn - 1))
        
        ' Get initial data
        ' Fix issue with invalid data type to MakeArray
        strSheetName = ws.Name
        ' end fix
        arrSpreadSheet = MakeArray(strSheetName)
        For y = 0 To UBound(arrSpreadSheet)
            If arrSpreadSheet(y, 0) <> "Account" And arrSpreadSheet(y, 0) <> "Site" Then
                intColStart = y + 1
                Exit For
            End If
        Next
        
        Sheets(1).Activate
        ' add the chart
        Set myChtObj = ActiveSheet.ChartObjects.Add _
            (Left:=250, Width:=(ActiveWindow.PointsToScreenPixelsX(ActiveWindow.Width) / 3), Top:=75, Height:=(ActiveWindow.PointsToScreenPixelsY(ActiveWindow.Height) / 1.5)) 'old width=375 - old height=225
        With myChtObj.Chart
            strRange = getAlphaIndex(intColStart) & "1:" & getAlphaIndex(UBound(arrSpreadSheet) + 1) & UBound(arrSpreadSheet, 2)
            ' Set Source Data
            .SetSourceData Source:=Sheets(ws.Name).Range(strRange)
                
            ' make an XY chart
            .ChartType = xlColumnClustered

            ' add title
            .HasTitle = True
            .ChartTitle.Text = ws.Name
        End With
'Rest cut to my Docs...
Contloop:
    Next i
    ArrangeMyCharts
    'Application.ScreenUpdating = True
    Exit Sub
Handler:
    MsgBox "Error: " & Err.Number & vbCrLf & vbcrlrf & Err.Description, vbExclamation, "Format Monthly Reports"
End Sub

Public Sub ChartArrange()
    Dim iChart As Long
    Dim nCharts As Long
    Dim dTop As Double
    Dim dLeft As Double
    Dim dHeight As Double
    Dim dWidth As Double
    Dim nColumns As Long

    dTop = 10      ' top of first row of charts
    dLeft = 10    ' left of first column of charts
    dHeight = (ActiveWindow.PointsToScreenPixelsY(ActiveWindow.Height) / 1.7) ' height of all charts
    dWidth = (ActiveWindow.PointsToScreenPixelsX(ActiveWindow.Width) / 2.5) ' width of all charts
    nColumns = 1   ' number of columns of charts
    nCharts = ActiveSheet.ChartObjects.Count

    For iChart = 1 To nCharts
        With ActiveSheet.ChartObjects(iChart)
            .Height = dHeight
            .Width = dWidth
            .Top = dTop + Int((iChart - 1) / nColumns) * dHeight
            .Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
        End With
    Next
End Sub