VBA

VBA (Visual Basic for Applications) is a programming language for Office automation, primarily used in Excel macros.

Sub HelloWorld()
    MsgBox "Hello, World!"
End Sub

Run with F5 in VBA Editor or assign to button.

Sub FormatReport()
    ' Select data range
    Range("A1:D10").Select

    ' Apply formatting
    Selection.Font.Bold = True
    Selection.Interior.Color = RGB(200, 220, 255)

    ' Auto-fit columns
    Columns("A:D").AutoFit
End Sub

Sub MyProcedure()
    ' Code here (no return value)
End Sub

Execute with Call MyProcedure() or MyProcedure.

Sub Greet(name As String)
    MsgBox "Hello, " & name
End Sub

' Call it
Call Greet("Alice")

Function AddNumbers(x As Integer, y As Integer) As Integer
    AddNumbers = x + y
End Function

' Use it
Dim result As Integer
result = AddNumbers(5, 3)

Function GetWorksheetName() As String
    GetWorksheetName = ActiveSheet.Name
End Function

Function IsWeekend(dt As Date) As Boolean
    IsWeekend = (Weekday(dt) = 1 Or Weekday(dt) = 7)
End Function

Dim name As String
Dim count As Integer
Dim price As Double
Dim isActive As Boolean

Const TAX_RATE As Double = 0.15
Const COMPANY_NAME As String = "Acme Corp"

Public Const MAX_ROWS As Long = 1000

' Module-level (top of module)
Dim moduleVar As String

' Procedure-level
Sub MyProcedure()
    Dim localVar As Integer
End Sub

' Public (accessible from other modules)
Public Shared globalVar As Boolean

If x > 10 Then MsgBox "Large"

If y = 0 Then Exit Sub

If score >= 90 Then
    grade = "A"
ElseIf score >= 80 Then
    grade = "B"
ElseIf score >= 70 Then
    grade = "C"
Else
    grade = "F"
End If

=   ' Equal
<>  ' Not equal
>   ' Greater than
<   ' Less than
>=  ' Greater or equal
<=  ' Less or equal

If age >= 18 And hasLicense = True Then
    MsgBox "Can drive"
End If

If day = "Saturday" Or day = "Sunday" Then
    MsgBox "Weekend"
End If

If Not isEmpty Then
    ProcessData
End If

Select Case dayOfWeek
    Case "Monday", "Tuesday", "Wednesday"
        MsgBox "Weekday"
    Case "Thursday", "Friday"
        MsgBox "Almost weekend"
    Case "Saturday", "Sunday"
        MsgBox "Weekend!"
    Case Else
        MsgBox "Invalid day"
End Select

Select Case score
    Case Is >= 90
        grade = "A"
    Case 80 To 89
        grade = "B"
    Case 70 To 79
        grade = "C"
    Case Else
        grade = "F"
End Select

Dim i As Integer
For i = 1 To 10
    Cells(i, 1).Value = i
Next i

' Count by 2s
For i = 0 To 10 Step 2
    Debug.Print i
Next i

' Count backwards
For i = 10 To 1 Step -1
    Debug.Print i
Next i

Dim cell As Range
For Each cell In Range("A1:A10")
    cell.Value = cell.Value * 2
Next cell

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    Debug.Print ws.Name
Next ws

Dim wb As Workbook
For Each wb In Application.Workbooks
    Debug.Print wb.Name
Next wb

Dim i As Integer
i = 1
Do While Cells(i, 1).Value <> ""
    Cells(i, 2).Value = Cells(i, 1).Value * 2
    i = i + 1
Loop

Dim row As Integer
row = 1
Do Until IsEmpty(Cells(row, 1))
    row = row + 1
Loop
MsgBox "Last row: " & row - 1

For i = 1 To 100
    If Cells(i, 1).Value = "STOP" Then
        Exit For
    End If
    ProcessRow i
Next i

Do While True
    If condition Then Exit Do
Loop

Dim names(5) As String
names(0) = "Alice"
names(1) = "Bob"

Dim matrix(3, 3) As Integer
matrix(1, 1) = 10

Dim items() As String
ReDim items(10)

' Resize and preserve data
ReDim Preserve items(20)

Dim colors As Variant
colors = Array("Red", "Green", "Blue")

Dim numbers As Variant
numbers = Array(1, 2, 3, 4, 5)

' Access elements
MsgBox colors(0)  ' "Red"

Dim arr(1 To 10) As Integer

' Get bounds
Dim lower As Integer
Dim upper As Integer
lower = LBound(arr)  ' 1
upper = UBound(arr)  ' 10

' Loop through array
For i = LBound(arr) To UBound(arr)
    arr(i) = i * 2
Next i

Dim sales(12, 4) As Double  ' 12 months, 4 quarters

sales(1, 1) = 1000.50
sales(1, 2) = 1200.75

' Loop through 2D array
For month = 1 To 12
    For quarter = 1 To 4
        Debug.Print sales(month, quarter)
    Next quarter
Next month

Dim text As String
text = "Hello World"

' Mid(string, start, length)
Mid(text, 1, 5)      ' "Hello"
Mid(text, 7)         ' "World"

' Left(string, length)
Left(text, 5)        ' "Hello"

' Right(string, length)
Right(text, 5)       ' "World"

' Length
Len("Hello")         ' 5

' Find substring position
InStr("Hello World", "World")  ' 7
InStr("Hello World", "xyz")    ' 0 (not found)

' Case-insensitive search
InStr(1, "Hello", "HELLO", vbTextCompare)  ' 1

' Replace
Replace("Hello World", "World", "VBA")  ' "Hello VBA"

' Trim whitespace
Trim("  Hello  ")    ' "Hello"
LTrim("  Hello")     ' "Hello"
RTrim("Hello  ")     ' "Hello"

' Case conversion
UCase("hello")       ' "HELLO"
LCase("HELLO")       ' "hello"

' StrComp(string1, string2, compare)
StrComp("ABC", "abc", vbTextCompare)  ' 0 (equal)
StrComp("ABC", "abc", vbBinaryCompare) ' -1 (not equal)

' Like operator (pattern matching)
"Hello" Like "H*"    ' True
"Test123" Like "Test###"  ' True

' Using &
name = "John"
greeting = "Hello, " & name & "!"

' Using + (not recommended)
message = "Line 1" + vbCrLf + "Line 2"

' Active workbook
Dim wb As Workbook
Set wb = ActiveWorkbook

' This workbook (where code runs)
Set wb = ThisWorkbook

' By index
Set wb = Workbooks(1)

' By name
Set wb = Workbooks("Sales.xlsx")

' Open workbook
Dim wb As Workbook
Set wb = Workbooks.Open("C:\Data\Report.xlsx")

' Create new workbook
Set wb = Workbooks.Add

' Save
ActiveWorkbook.Save

' Save As
ActiveWorkbook.SaveAs "C:\Data\NewFile.xlsx"

' Close
wb.Close SaveChanges:=True

' Get workbook name
Debug.Print ActiveWorkbook.Name

' Get full path
Debug.Print ActiveWorkbook.FullName

' Get path (folder)
Debug.Print ActiveWorkbook.Path

' Check if saved
If ActiveWorkbook.Saved = False Then
    ActiveWorkbook.Save
End If

Dim count As Integer
count = Workbooks.Count

MsgBox "Open workbooks: " & count

' Active sheet
Dim ws As Worksheet
Set ws = ActiveSheet

' By index
Set ws = Worksheets(1)

' By name
Set ws = Worksheets("Sales")

' Short syntax
Set ws = Sheets("Data")

' Add new worksheet
Dim newSheet As Worksheet
Set newSheet = Worksheets.Add

' Add with name
Set newSheet = Worksheets.Add
newSheet.Name = "Report"

' Delete worksheet
Application.DisplayAlerts = False
Worksheets("OldData").Delete
Application.DisplayAlerts = True

' Copy worksheet
Worksheets("Template").Copy After:=Worksheets(1)

' Rename
Worksheets(1).Name = "Summary"

' Visibility
Worksheets("Hidden").Visible = xlSheetHidden
Worksheets("Hidden").Visible = xlSheetVisible

' Protect/Unprotect
ActiveSheet.Protect Password:="secret"
ActiveSheet.Unprotect Password:="secret"

' Tab color
Worksheets("Sales").Tab.Color = RGB(255, 0, 0)

Dim count As Integer
count = ThisWorkbook.Worksheets.Count

MsgBox "Total sheets: " & count

' By address
Range("A1").Value = 100
Range("A1:C10").Select

' By Cells(row, col)
Cells(1, 1).Value = "Header"
Cells(5, 2).Value = 999

' Combined
Range(Cells(1, 1), Cells(10, 5)).Select

' Named range
Range("SalesData").Select

' Get/Set value
Dim val As Variant
val = Range("A1").Value
Range("B1").Value = val * 2

' Formula
Range("C1").Formula = "=A1+B1"
Range("C1").FormulaR1C1 = "=RC[-2]+RC[-1]"

' Text
Range("A1").Text  ' Read-only formatted text

' Select range
Range("A1:D10").Select

' Entire row/column
Rows(1).Select
Columns("A").Select

' Current region (contiguous data)
Range("A1").CurrentRegion.Select

' Used range
ActiveSheet.UsedRange.Select

With Range("A1:D1")
    .Font.Bold = True
    .Font.Size = 14
    .Font.Color = RGB(255, 0, 0)
    .Interior.Color = RGB(200, 200, 200)
    .HorizontalAlignment = xlCenter
End With

' Number format
Range("A1").NumberFormat = "$#,##0.00"
Range("B1").NumberFormat = "0.00%"
Range("C1").NumberFormat = "mm/dd/yyyy"

' Copy/Paste
Range("A1:A10").Copy Destination:=Range("B1")

' Clear
Range("A1:D10").Clear          ' Everything
Range("A1:D10").ClearContents  ' Values only
Range("A1:D10").ClearFormats   ' Formats only

' Delete/Insert
Range("A1:A10").Delete Shift:=xlUp
Range("A1").EntireRow.Insert

' AutoFit
Columns("A:D").AutoFit
Rows("1:10").AutoFit

' Last row with data in column A
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

' Last column with data in row 1
Dim lastCol As Long
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

MsgBox "Last row: " & lastRow

MsgBox "Operation complete!"

MsgBox "Error: File not found", vbCritical

MsgBox "Data saved successfully", vbInformation, "Success"

Dim result As VbMsgBoxResult

result = MsgBox("Save changes?", vbYesNo)
If result = vbYes Then
    SaveData
End If

result = MsgBox("Delete?", vbYesNoCancel, "Confirm")
Select Case result
    Case vbYes
        DeleteData
    Case vbNo
        ' Do nothing
    Case vbCancel
        Exit Sub
End Select

' vbInformation (blue i)
MsgBox "Info", vbInformation

' vbExclamation (yellow !)
MsgBox "Warning", vbExclamation

' vbCritical (red X)
MsgBox "Error", vbCritical

' vbQuestion (blue ?)
MsgBox "Continue?", vbQuestion

Dim name As String
name = InputBox("Enter your name:", "User Input")

If name <> "" Then
    MsgBox "Hello, " & name
End If

' With default value
Dim age As String
age = InputBox("Enter age:", "Age", "25")

' Select range
Dim rng As Range
Set rng = Application.InputBox("Select range:", Type:=8)

If Not rng Is Nothing Then
    rng.Interior.Color = RGB(255, 255, 0)
End If

Sub ErrorHandlingExample()
    On Error GoTo ErrorHandler

    ' Code that might fail
    Dim wb As Workbook
    Set wb = Workbooks.Open("C:\missing.xlsx")

    Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description, vbCritical
    Err.Clear
End Sub

Sub IgnoreErrors()
    On Error Resume Next

    ' Try to delete (ignore if doesn't exist)
    Worksheets("TempData").Delete

    On Error GoTo 0  ' Turn off error handling
End Sub

Sub DetailedError()
    On Error GoTo ErrorHandler

    ' Risky code
    Dim x As Integer
    x = 10 / 0

    Exit Sub

ErrorHandler:
    MsgBox "Error #" & Err.Number & vbCrLf & _
           "Description: " & Err.Description & vbCrLf & _
           "Source: " & Err.Source
    Err.Clear
End Sub

Sub ValidateInput(age As Integer)
    If age < 0 Or age > 150 Then
        Err.Raise Number:=vbObjectError + 1, _
                  Description:="Invalid age"
    End If
End Sub

Sub ProcessRows()
    Dim i As Long
    Dim lastRow As Long

    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow  ' Skip header
        If Cells(i, 1).Value > 100 Then
            Cells(i, 3).Value = "High"
        Else
            Cells(i, 3).Value = "Low"
        End If
    Next i
End Sub

Sub ConsolidateSheets()
    Dim ws As Worksheet
    Dim masterRow As Long

    masterRow = 2  ' Start after header

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Summary" Then
            Dim lastRow As Long
            lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

            ws.Range("A2:D" & lastRow).Copy _
                Worksheets("Summary").Cells(masterRow, 1)

            masterRow = masterRow + (lastRow - 1)
        End If
    Next ws
End Sub

Sub FindAndReplace()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        ws.Cells.Replace What:="old", _
                        Replacement:="new", _
                        LookAt:=xlWhole, _
                        MatchCase:=False
    Next ws
End Sub

Sub CreateDataTable()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim tbl As ListObject

    Set ws = ActiveSheet
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

    ' Convert range to table
    Set tbl = ws.ListObjects.Add(xlSrcRange, _
                ws.Range("A1:D" & lastRow), , xlYes)

    tbl.Name = "SalesData"
    tbl.TableStyle = "TableStyleMedium2"
End Sub

Sub ExportToCSV()
    Dim filePath As String

    filePath = ThisWorkbook.Path & "\export.csv"

    ActiveSheet.Copy
    With ActiveWorkbook
        .SaveAs Filename:=filePath, FileFormat:=xlCSV
        .Close SaveChanges:=False
    End With
End Sub

Sub ShowProgress()
    Dim i As Long
    Dim total As Long

    total = 1000

    For i = 1 To total
        ' Update status bar
        Application.StatusBar = "Processing: " & _
            Format(i / total, "0%")

        ' Your code here
        DoEvents  ' Keep Excel responsive
    Next i

    Application.StatusBar = False  ' Clear status
End Sub

Sub DebugExample()
    Dim x As Integer
    x = 10

    Debug.Print "Value of x: " & x
    Debug.Print "Workbook: " & ThisWorkbook.Name
End Sub

View output in Immediate Window (Ctrl+G).

Sub StepThrough()
    Dim i As Integer

    For i = 1 To 10
        ' Click left margin to set breakpoint
        Cells(i, 1).Value = i * 2
    Next i
End Sub

Press F8 to step through code, F5 to continue.

Sub WatchVariables()
    Dim total As Double
    Dim count As Integer

    ' Add watches in VBA Editor: View > Watch Window
    total = 0
    For count = 1 To 100
        total = total + count
    Next count
End Sub

' Type in Immediate Window (Ctrl+G):
? Cells(1, 1).Value
? ActiveSheet.Name
? Worksheets.Count

' Execute statements:
Cells(1, 1).Value = 100
Range("A1:A10").ClearContents

Sub FastMacro()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Your code here

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

' Bad
Range("A1").Font.Bold = True
Range("A1").Font.Size = 14
Range("A1").Font.Color = RGB(255, 0, 0)

' Good
With Range("A1").Font
    .Bold = True
    .Size = 14
    .Color = RGB(255, 0, 0)
End With

' Bad (implicit ActiveSheet)
Range("A1").Value = 100

' Good (explicit reference)
ThisWorkbook.Worksheets("Data").Range("A1").Value = 100

' Bad
If Cells(i, 5).Value > 1000 Then

' Good
Const COL_SALES As Integer = 5
Const THRESHOLD As Long = 1000

If Cells(i, COL_SALES).Value > THRESHOLD Then

Sub CleanupExample()
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = Workbooks.Open("data.xlsx")
    Set ws = wb.Worksheets(1)

    ' Use objects

    ' Cleanup
    wb.Close SaveChanges:=False
    Set ws = Nothing
    Set wb = Nothing
End Sub