VBA: Office Automation

51.1 Getting Started with VBA

Enable the Developer tab (File → Options → Customize Ribbon) and open the VBA editor with Alt+F11.

Save macro-enabled files as .xlsm, .docm, .pptm, or .accdb. Use the Macro Recorder to learn the object model.

Code goes in Modules (standard), Class Modules, UserForms, and object modules (ThisWorkbook, Sheet1).

51.2 VBA Language Essentials (Differences from VB.NET)

Set obj =... for objects Integer = 16-bit, Long = 32-bit Integer = 32-bit, Long = 64-bit Variant type On Error GoTo / Resume

Arrays can have any lower bound (Option Base 1, Dim a(1 To 10)) Collection, Scripting.Dictionary No inheritance (only Implements) Debug.Print + Immediate window Function returns via its name No AndAlso (no short-circuit)

Option Explicit                         ' always use

Sub HelloWorld()
    Dim name As String
    Dim count As Long                   ' use Long, not Integer (overflow at 32,767)
    Dim rng As Range
    name = "Ana"
    count = 10
    Set rng = ThisWorkbook.Sheets("Data").Range("A1")   ' Set is REQUIRED for object assignment
    rng.Value = "Hello " & name
    MsgBox "Done! Count = " & count, vbInformation, "Macro"
End Sub

Function AddTax(amount As Double, Optional rate As Double = 0.18) As Double
    AddTax = amount * (1 + rate)        ' return by assigning to the function name
End Function                            ' usable as an Excel formula: =AddTax(A1)

51.3 Excel Object Model

Sub ExcelBasics()
    Dim wb As Workbook, ws As Worksheet, lastRow As Long, i As Long
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sales")

    ws.Range("A1").Value = "Product"
    ws.Range("A1:D1").Font.Bold = True
    ws.Cells(2, 1).Value = "Laptop"                   ' Cells(row, column)
    ws.Range("D2").Formula = "=B2*C2"

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row   ' find the last used row
    For i = 2 To lastRow
        If ws.Cells(i, "D").Value > 1000 Then
            ws.Rows(i).Interior.Color = RGB(255, 230, 230)
        End If
    Next i

    ws.Range("A1").CurrentRegion.Sort Key1:=ws.Range("D2"), Order1:=xlDescending, Header:=xlYes
    ws.Columns("A:D").AutoFit
    ws.ListObjects.Add(xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes).Name = "SalesTable"

    Dim newWs As Worksheet
    Set newWs = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    newWs.Name = "Summary"
    newWs.Range("A1").Value = Application.WorksheetFunction.Sum(ws.Range("D2:D" & lastRow))
End Sub

Sub FastLoop()
    Dim data As Variant, i As Long
    Application.ScreenUpdating = False                 ' speed up
    Application.Calculation = xlCalculationManual
    data 
…

51.4 Events, UserForms and Error Handling

' In the Sheet1 module
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B:B")) Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(0, 1).Value = Now                ' timestamp next to the edited cell
        Application.EnableEvents = True
    End If
End Sub

' In ThisWorkbook
Private Sub Workbook_Open()
    MsgBox "Welcome!"
End Sub

' UserForm code
Private Sub cmdSave_Click()
    If Trim(txtName.Value) = "" Then
        MsgBox "Name required", vbExclamation
        Exit Sub
    End If
    Dim nextRow As Long
    nextRow = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Sheets("Data").Cells(nextRow, 1).Value = txtName.Value
    Unload Me
End Sub

' Error handling
Sub SafeImport()
    On Error GoTo ErrHandler
    Workbooks.Open "C:\Data\import.xlsx"
    ' ...
CleanExit:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
    Resume CleanExit
End Sub

51.5 Other Office Applications

More topics: class modules in VBA (Implements, custom events with WithEvents), Scripting.Dictionary and FileSystemObject (Microsoft Scripting Runtime), ADO for external databases, API declarations (Declare PtrSafe Function for 64-bit Office), add-ins (.xlam), ribbon customization (customUI XML), digital signatures, Power Query/Office Scripts as modern alternatives.

' Outlook: send email from Excel (early binding needs a reference to the Outlook Object Library)
Sub SendReport()
    Dim olApp As Object, mail As Object
    Set olApp = CreateObject("Outlook.Application")
    Set mail = olApp.CreateItem(0)
    With mail
        .To = "team@example.com"
        .Subject = "Daily Report"
        .Body = "Please find the report attached."
        .Attachments.Add ThisWorkbook.FullName
        .Display            ' or .Send
    End With
End Sub

' Word: generate a document
Sub CreateWordDoc()
    Dim wdApp As Object, doc As Object
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    Set doc = wdApp.Documents.Add
    doc.Content.Text = "Generated by VBA on " & Format(Date, "dd-mmm-yyyy")
    doc.SaveAs2 "C:\Temp\report.docx"
End Sub

' Access: query with DAO
Sub AccessQuery()
    Dim db As DAO.Database, rs As DAO.Recordset
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT * FROM Customers WHERE City = 'Pune'")
    Do While Not rs.EOF
        Debug.Print rs!Name
        rs.MoveNext
    Loop
    rs.Close
End Sub