After making my original post VBA – Automating Excel I received a few e-mails and comments asking for some more in depth examples of how this approach can be extended further to make one life easier.

So, I thought I’d demonstrate a couple more functions that can be used/adapted. The entire idea is that you can create reusable functions for coding that you need to perform regularily.

Table Border Formatting

A concrete example, when coding Excel, is that I often need to add borders around a range to format it all pretty. So you could create a function such as the one provided below and then whenever you need to apply borders to a range, you can perform the formatting by calling a single line of code.

Sub Rng_ApplyBorder(Rng As Object, RngHeader As Object)
    On Error GoTo Error_Handler

    With RngHeader.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With RngHeader.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Rng.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Rng.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Rng.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Rng.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Rng.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Rng.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

    ' Auto-fit the column widths and row heights
    oExcel.Selection.CurrentRegion.Columns.AutoFit
    'Freeze the first row
    oExcelWrSht.Rows("2:2").Select
    oExcel.ActiveWindow.FreezePanes = True
    oExcelWrSht.Range("A1").Select  'Return to the top of the page

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Rng_ApplyBorder" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Calling the function then is no harder than

Call Rng_ApplyBorder(oExcelWrSht.Range("A1:F326"), oExcelWrSht.Range("A1:F1"))

or here is a slightly streamlined version of the Rng_ApplyBorder procedure:

Sub Rng_ApplyBorder2(Rng As Object, RngHeader As Object)
On Error GoTo Error_Handler
    Dim aOutsideBorders(3)    As Long
    Dim aInsideBorders(1)     As Long
    Dim i                     As Byte

    aOutsideBorders(0) = xlEdgeLeft
    aOutsideBorders(1) = xlEdgeRight
    aOutsideBorders(2) = xlEdgeTop
    aOutsideBorders(3) = xlEdgeBottom

    aInsideBorders(0) = xlInsideVertical
    aInsideBorders(1) = xlInsideHorizontal

    With RngHeader.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With RngHeader.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    'Set the Outside Borders
    For i = 0 To UBound(aOutsideBorders)
        With Rng.Borders(aOutsideBorders(i))
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
    Next i
    'Set the Inside Borders
    For i = 0 To UBound(aInsideBorders)
        With Rng.Borders(aInsideBorders(i))
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    Next i

    ' Auto-fit the column widths and row heights
    oExcel.Selection.CurrentRegion.Columns.AutoFit
    'Freeze the first row
    oExcelWrSht.Rows("2:2").Select
    oExcel.ActiveWindow.FreezePanes = True
    oExcelWrSht.Range("A1").Select  'Return to the top of the page

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Rng_ApplyBorder2" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Calling the function then is no harder than

Call Rng_ApplyBorder2(oExcelWrSht.Range("A1:F326"), oExcelWrSht.Range("A1:F1"))

PageSetup

Another concrete example, setting the various page setup settings for printing purposes. Once again, a very simple function like the one below can be created.

Sub WrkSht_SetupPage(Rng As Object)
    On Error GoTo Error_Handler
    
    With oExcelWrSht.PageSetup
        .PrintTitleRows = "$1:$1"
        .zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintArea = Rng.Address
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = Format(Now, "yyyy-mmm-dd h:nn")
        .CenterFooter = "Page &P de &N"
        .RightFooter = ""
    End With

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: WrkSht_SetupPage" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

And again a single line of code now applies your preferred settings:

Call WrkSht_SetupPage(oExcelWrSht.Range("A1:F326"))

Charting

Another common need for automation in Excel is creating charts. Below is another example of how such a task can be automated and transformed into a reusable procedure.

Sub GenColumnChart(Rng As Object, RngChartLoc As Object, sTitle As String, sXAxisTitle As String, sYAxisTitle As String)
    On Error GoTo Error_Handler
    Dim oChart                As Object

    oExcelWrSht.Shapes.AddChart2(286, xl3DColumnClustered).Select
    'Position and size the Chart on the current page
    Set oChart = oExcel.ActiveChart.Parent
    oChart.Height = RngChartLoc.Height
    oChart.Width = RngChartLoc.Width
    oChart.Top = RngChartLoc.Top
    oChart.Left = RngChartLoc.Left
    'Format the Chart (Title, Axis Titles, remove legend)
    With oExcel.ActiveChart
        .HasLegend = False 'Remove the Legend
        .ChartType = xl3DColumnClustered 'Specify the chart type to create
        .SetSourceData Source:=Rng 'Specify the data series
        .HasTitle = True
        .ChartTitle.Characters.Text = sTitle 'Set the Chart Title
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = sXAxisTitle 'Set the X Axis Title
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = sYAxisTitle 'Set the Y Axis Title
    End With

Error_Handler_Exit:
    On Error Resume Next
    Set oChart = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GenColumnChart" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Then you’d call such a function like:

Call GenColumnChart(oExcelWrSht.Range("A1:F326"), _
                    oExcelWrSht.Range("H5:M35"), _
                    "Population by City", _
                    "City", _
                    "Population")

Taking it Further

The procedures given above are very simple procedures that I created for illustrative purposes. Obviously, you could make them much more versatile by adding more input variables and linking them to the various properties.

For instance:

• the Rng_ApplyBorder Sub could include a variable for the color to apply.
• the WrkSht_SetupPage Sub could include variables for the Number of page wide or tall, or the various headers/footers, etc…
• the GenColumnChart sub could include variables to include or not the legend, specify the chart type to create, …

by doing so you will end up with extremely flexible reusable procedures that will work for any and all scenarios and that it were lies the true strength of such an approach!

What are the Benefits

So what are the benefits to such an approach you are probably asking yourself! I can simply create a single procedure which contains all the code and it will work just fine, no?!

Yes, this is true and in a one off situation one may not see the benefit to such an approach, but there are several.

• One benefit is by breaking down big procedures into components is that troubleshooting becomes easier and error reporting can become clearer.
• But the biggest benefit is that by creating a series of smaller procedures, you build yourself a library of reusable code that you can call whenever need be. You can now create an Excel VBA module, Word VBA module, … and quickly be able to import them into any new project you undertake and have all the functionality you need without having to dissect procedures scattered throughout other projects.
• Lastly, by using reusable procedures, you minimize the amount of code you have to write.

And don’t forget that when trying to create your own procedure in Word, Excel, … the Macro recorder is one of your best friends to get the basic code. That said, often the macro recorder adds a lot of useless code so you always need to go through it and try and remove anything that is redundant or useless.

I hope this helps illustrate the principle a little bit more.