Excel Macro Examples

The following simple Excel macro examples were used in the Excel-VBA-Tutorial to illustrate various features of VBA, including code presentation and documentation.

Excel Macro Example 1

The following Sub procedure was initially used to illustrate the use of comments in VBA code. However, this code also contains examples of:

' Sub procedure to search cells A1-A100 of the current active
' sheet, and find the cell containing the supplied string
Sub Find_String(sFindText As String)
Dim i As Integer           ' Integer used in 'For' loop
Dim iRowNumber As Integer   ' Integer to store result
iRowNumber = 0
' Loop through cells A1-A100 until 'sFindText' is found
For i = 1 To 100
If Cells(i, 1).Value = sFindText Then
' A match has been found to the supplied string
' Store the current row number and exit the 'For' Loop
iRowNumber = i
Exit For
End If
Next i
' Pop up a message box to let the user know if the text
' string has been found, and if so, which row it appears on
If iRowNumber = 0 Then
MsgBox "String " & sFindText & " not found"
Else
MsgBox "String " & sFindText & " found in cell A" & iRowNumber
End If
End Sub


Excel Macro Example 2

The following Sub procedure lists all values in the Fibonacci series, up to 1,000. This provides examples of:

' Sub procedure to list the Fibonacci series for all values below 1,000
Sub Fibonacci()
Dim i As Integer   ' counter for the position in the series
Dim iFib As Integer   ' stores the current value in the series
Dim iFib_Next As Integer   ' stores the next value in the series
Dim iStep As Integer   ' stores the next step size
' Initialise the variables i and iFib_Next
i = 1
iFib_Next = 0
' Do While loop to be executed as long as the value of the
' current Fibonacci number exceeds 1000
Do While iFib_Next < 1000
If i = 1 Then
' Special case for the first entry of the series
iStep = 1
iFib = 0
Else
' Store the next step size, before overwriting the
' current entry of the series
iStep = iFib
iFib = iFib_Next
End If
' Print the current Fibonacci value to column A of the
' current Worksheet
Cells(i, 1).Value = iFib
' Calculate the next value in the series and increment
' the position marker by 1
iFib_Next = iFib + iStep
i = i + 1
Loop
End Sub


Excel Macro Example 3

The following Sub procedure reads values from the cells of column A of the active Worksheet, until it encounters a blank cell. The values are stored in an array. This simple Excel macro example illustrates the use of:

' Sub procedure store values in Column A of the active Worksheet
' into an array

Sub GetCellValues()
Dim iRow As Integer            ' stores the current row number
Dim dCellValues() As Double  ' array to store the cell values
iRow = 1
ReDim dCellValues(1 To 10)
' Do Until loop to extract the value of each cell in column A
' of the active Worksheet, as long as the cell is not blank
Do Until IsEmpty(Cells(iRow, 1))
' Check that the dCellValues array is big enough
' If not, use ReDim to increase the size of the array by 10
If UBound(dCellValues) < iRow Then
ReDim Preserve dCellValues(1 To iRow + 9)
End If
' Store the current cell in the CellValues array
dCellValues(iRow) = Cells(iRow, 1).Value
iRow = iRow + 1
Loop
End Sub


Excel Macro Example 4

The following Sub procedure reads values from Column A of the Worksheet named "Sheet2" and performs arithmetic operations on the values. The resulting values are printed out into Column A of the current active Worksheet.

This macro illustrates:

' Sub procedure to loop through the values in Column A of the Worksheet
' "Sheet2", perform arithmetic operations on each value, and write the
' result into Column A of the current Active Worksheet ("Sheet1")
Sub Transfer_ColA()
Dim i As Integer
Dim Col As Range
Dim dVal As Double
' Set the variable 'Col' to be Column A of Sheet 2
Set Col = Sheets("Sheet2").Columns("A")
i = 1
' Loop through each cell of the column 'Col' until
' a blank cell is encountered
Do Until IsEmpty(Col.Cells(i))
' Apply arithmetic operations to the value of the current cell
dVal = Col.Cells(i).Value * 3 - 1
' The command below copies the result into Column A
' of the current Active Worksheet - no need to specify
' the Worksheet name as it is the active Worksheet.
Cells(i, 1) = dVal
i = i + 1
Loop
End Sub


Excel Macro Example 5

The following macro provides an example of vba code linked to an Excel Event. The macro is linked to the Excel Event, 'SelectionChange', which is activated every time a different cell or range of cells is selected within a worksheet. The code uses the built-in MsgBox function to display a message box if cell B1 is selected.

' Code to display a Message Box if Cell B1 of the current Worksheet
' is selected.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Check if the selection is cell B1
If Target.Count = 1 And Target.Row = 1 And Target.Column = 2 Then
' The selection IS cell B1, so carry out required actions
MsgBox "You have selected cell B1"
End If
End Sub


Excel Macro Example 6

The following Sub procedure illustrates the use of the On Error and Resume statements, for handling runtime errors. The code also includes examples of opening, and reading data from a file

' Sub procedure to set the supplied values, Val1 and Val2 to the values
' in cells A1 and B1 of the Workbook "Data.xls" in the C:\ directory
Sub Set_Values(Val1 As Double, Val2 As Double)
Dim DataWorkbook As Workbook
On Error GoTo ErrorHandling
' Open the Data Workbook
Set DataWorkbook = Workbooks.Open("C:\Documents and Settings\Data")
' Set the variables Val1 and Val2 from the data in DataWorkbook
Val1 = Sheets("Sheet1").Cells(1, 1)
Val2 = Sheets("Sheet1").Cells(1, 2)
DataWorkbook.Close
Exit Sub
ErrorHandling:
' If the file is not found, ask the user to place it into
' the correct directory and then resume
MsgBox "Data Workbook not found;" & _
       "Please add the workbook to C:\Documents and Settings and click OK"
Resume
End Sub