he
following simple Excel macro examples were used in the Excel-VBA-Tutorial to
illustrate specific features of VBA, including code presentation and
documentation.
Excel Macro Example
The
following Sub procedure was initially used to illustrate the use of comments in
VBA code. However, this code also contains examples of variable declaration,
Excel cell referencing, a 'For' loop, 'If' statements, and the built-in VBA
MsgBox function.
' 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 in
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 1
The
following Sub procedure is an example of use of a Do While Loop.
It also contains examples of variable declarations, Excel cell referencing and
the 'If' statement.
' 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 2
The
following Sub procedure reads values from the cells of column A of the active
spreadsheet, until it encounters a blank cell. The values are stored in an
array. This simple Excel macro example illustrates the use of dynamic arrays
and also the use of the Do Until loop.
' 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 3
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 example shows the use of Excel objects. Specifically, the Sub accesses
the 'Columns' object via the 'Worksheet' object. The example also illustrates
how, when accessing a cell or cell range on the current active Worksheet, you
do not need to include a reference to the Worksheet.
' 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 4
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 5
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
|
No comments:
Post a Comment