Skip to content

Instantly share code, notes, and snippets.

@matachi

matachi/vba-notes.md

Created April 17, 2015 18:37
Show Gist options
  • Save matachi/0d8fd28029479db71b23 to your computer and use it in GitHub Desktop.
Save matachi/0d8fd28029479db71b23 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
vba-notes.md

Sub procedure

Sub AddEmUp()
    Sum = 1 + 1
    MsgBox "The answer is " & Sum
End Sub

Function procedures

Function AddTwo(arg1, arg2)
    AddTwo = arg1 + arg2
End Function

Object properties

Sub ShowValue()
    Contents = Worksheets("Sheet1").Range("A1").Value
    MsgBox Contents
End Sub

Method arguments

Sub CopyOne()
    Worksheets("Sheet1").Activate
    Range("A1").Copy Range("B1")
End Sub

Named argument

Range("A1").Copy Destination:=Range("B1")

Space or parenthesis

http://stackoverflow.com/questions/5413765/what-are-the-rules-governing-usage-of-brackets-in-vba-function-calls

Execute a procedure from another procedure

Sub NewSub()
    Call ShowCubeRoot
End Sub

Executing a function procedure

Function CubeRoot(number)
    CubeRoot = number ^ (1/3)
End Function

Call the function from a sub procedure

Sub CallerSub()
    Ans = CubeRoot(125)
    MsgBox Ans
End Sub

or

Sub CallerSub()
    MsgBox CubeRoot(125)
End Sub

Call the function from a worksheet formula

=CubeRoot(1728)

Comments

Sub FormatCells()
'   Exit if a range is not selected
    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range."
        Exit Sub
    End If
'   Format the cells
    With Selection
        .HorizontalAlignment = xlRight
        .WrapText = False ‘ no wrap
        .MergeCells = False ‘ no merged cells
    End With
End Sub

Variables

x = 1
InterestRate = 0.075
LoanPayoffAmount = 243089
DataEntered = False
x = x + 1
UserName = "Bob Johnson"
Date_Started = #3/14/2013#
MyNum = YourNum * 1.25

Dim

https://msdn.microsoft.com/en-us/library/7ee5a7s1.aspx

Dim numberOfStudents As Integer
Dim finished As Boolean
Dim monitorBox As System.Windows.Forms.Form
Dim bottomLabel As New System.Windows.Forms.Label

Public maximumAllowed As Double
Protected Friend currentUserName As String
Private salary As Decimal
Static runningTotal As Integer

Dim quantity As Integer = 10
Dim message As String = "Just started"

Dim student1 As New Student With {.First = "Michael",
                                  .Last = "Tucker"}

Dim lastTime, nextTime, allTimes() As Date

Dim a, b, c As Single, x, y As Double, i As Integer

Dim totals(20) As Integer
Dim totals(0 To 20) As Integer

Dim matrix2(3, 5) As Double

Static

Sub MySub()
    Static Counter As Integer
    Dim Msg As String
    Counter = Counter + 1
    Msg = "Number of executions: " & Counter
    MsgBox Msg
End Sub

Const

Const NumQuarters As Integer = 4
Const Rate = .0725, Period = 12
Const ModName As String = "Budget Macros"
Public Const AppName As String = "Budget Application"

Pre-made constants

xlCalculationAutomatic
xlCalculationManual
xlCalculationSemiautomatic

Strings

Fixed-length string:

Dim MyString As String * 50

Variable-length string:

Dim YourString As String

Dates

Dim Today As Date
Dim StartTime As Date
Const FirstDay As Date = #1/1/2013#
Const Noon = #12:00:00#

Assignment statements

x = 1
x = x + 1
x = (y * 2) / (z * 2)
HouseCost = 375000
FileOpen = True
Range("TheYear").Value = 2013

Arrays

Dim MyArray(1 To 100) As Integer

Creates the same 101-element array:

Dim MyArray (0 To 100) As Integer
Dim MyArray (100) As Integer

Multidimensional arrays

Dim MyArray (1 To 9, 1 To 9) As Integer

Assignment to the third row, fourth column:

MyArray (3, 4)= 125

Three-dimensional array:

Dim My3DArray (1 To 10, 1 To 10, 1 To 10) As Integer

Dynamic arrays

Dim MyArray () As Integer

Change the number of elements in a dynamic array:

ReDim MyArray (1 To NumElements)

ReDim = redimension

Preserve values when redimensioning an array:

ReDim Preserve MyArray(1 To NumElements)

Range objects

One cell:

Range("K9")

Several rows and columns:

Range("A1:C5")

Named range:

Range("PriceList")

A range outside the active sheet:

Worksheets("Sheet1").Range("A1:C5")

A range in a different workbook:

Workbooks("Budget.xlsx").Worksheets("Sheet1").Range("A1:C5")

Entire row:

Range("3:3")

Entire column:

Range("D:D")

Noncontiguous ranges:

Range("A1:B8,D9:G16")

Cells property

Cell C2:

Worksheets("Sheet2").Cells(2, 3)

80 cell range that extends from cell A1 (row 1, column 1) to cell H10 (row 10, column 8):

Range(Cells(1, 1), Cells(10, 8))

Produce the same result:

Range("A1:H10").Value = 99
Range(Cells(1, 1), Cells(10, 8)).Value = 99

Offset property

Cell C2:

Range("A1").Offset(1, 2)

Cell A1:

Range("C2").Offset(-1, -2)

Insert the time of the day into the cell to the right of the active cell:

ActiveCell.Offset(0,1) = Time

Range object properties

Display the value in the cell A1 on Sheet1:

MsgBox Worksheets("Sheet1").Range("A1").Value

Value is the default property, these are equivalent:

Range("A1").Value = 75
Range("A1") = 75

Display the cell's content as it's displayed in Excel:

MsgBox Worksheets("Sheet1").Range("A1").Text

For instance, the value 12.3 might become $12.30.

Number of cells in a range:

MsgBox Range("A1:C3").Count

Column number (6):

MsgBox Sheets("Sheet1").Range("F3").Column

Row number (3):

MsgBox Sheets("Sheet1").Range("F3").Row

If the range consists of more than one row or column, these two properties return the first.

The absolute address:

MsgBox Range(Cells(1, 1), Cells(5, 5)).Address

Which displays $A$1:$E$5.

If a cell contains a formula:

Dim FormulaTest As Boolean
FormulaTest = Range("A1").HasFormula

Font property:

Range("A1").Font.Bold = True

Interior property:

Range("A1").Interior.Color = 8421504

Formula property:

Range("A13").Formula = "=SUM(A1:A12)"

Enter a formula containing quotes (=SUM(A1:A12)&" Stores"):

Range("A13").Formula = "=SUM(A1:A12)&"" Stores"""

If the cell doesn't have a Formula, it returns the Value instead.

Number format property:

Columns("A:A").NumberFormat = "0.00%"

Range object methods

Select method:

Range("A1:C12").Select

Copy and paste methods:

Sub CopyRange()
    Range("A1:A12").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
End Sub

This does the same thing:

Sub CopyRange2()
    Range("A1:A12").Copy Range("C1")
End Sub

Clear method:

Columns("D:D").Clear

Delete method:

Rows("6:6").Delete

GoTo statement

Sub CheckUser()
    UserName = InputBox("Enter Your Name: ")
    If UserName <> "Steve Ballmer" Then GoTo WrongName
    MsgBox ("Welcome Steve...")
' ...[More code here] ...
    Exit Sub
WrongName:
    MsgBox "Sorry. Only Steve Ballmer can run this."
End Sub

If-Then structure

Sub CheckUser2()
    UserName = InputBox("Enter Your Name: ")
    If UserName = "Steve Ballmer" Then
        MsgBox ("Welcome Steve...")
'       ...[More code here] ...
    Else
        MsgBox "Sorry. Only Steve Ballmer can run this."
    End If
End Sub

Without the optional Else clause:

Sub GreetMe()
    If Time < 0.5 Then MsgBox "Good Morning"
End Sub

With an alternative:

Sub GreetMe2()
    If Time < 0.5 Then MsgBox "Good Morning"
    If Time >= 0.5 Then MsgBox "Good Afternoon"
End Sub

Using an Else clause:

Sub GreetMe3()
    If Time < 0.5 Then MsgBox "Good Morning" Else _
      MsgBox "Good Afternoon"
End Sub

Where the If-Then-Else statement is a single statement and where _ is line continuation character.

Alternative way to write it:

Sub GreetMe4()
    If Time < 0.5 Then
        MsgBox "Good Morning"
    Else
        MsgBox "Good Afternoon"
    End If
End Sub

ElseIf:

Sub GreetMe7()
    Dim Msg As String
    If Time < 0.5 Then
        Msg = "Morning"
    ElseIf Time >= 0.5 And Time < 0.75 Then
        Msg = "Afternoon"
    Else
        Msg = "Evening"
    End If
    MsgBox "Good " & Msg
End Sub

Select Case structure

Sub ShowDiscount3()
    Dim Quantity As Integer
    Dim Discount As Double
    Quantity = InputBox("Enter Quantity: ")
    Select Case Quantity
        Case 0 To 24
            Discount = 0.1
        Case 25 To 49
            Discount = 0.15
        Case 50 To 74
            Discount = 0.2
        Case Is >= 75
            Discount = 0.25
    End Select
    MsgBox "Discount: " & Discount
End Sub

Alternative way to write it:

Sub ShowDiscount4 ()
    Dim Quantity As Integer
    Dim Discount As Double
    Quantity = InputBox("Enter Quantity: ")
    Select Case Quantity
        Case 0 To 24: Discount = 0.1
        Case 25 To 49: Discount = 0.15
        Case 50 To 74: Discount = 0.2
        Case Is >= 75: Discount = 0.25
    End Select
    MsgBox "Discount: " & Discount
End Sub

For-Next loops

Sub AddNumbers()
    Dim Total As Double
    Dim Cnt As Integer
    Total = 0
    For Cnt = 1 To 1000
        Total = Total + Cnt
    Next Cnt
    MsgBox Total
End Sub

Example with a Step value:

Sub ShadeEveryThirdRow()
    Dim i As Long
    For i = 1 To 100 Step 3
        Rows(i).Interior.Color = RGB(200, 200, 200)
    Next i
End Sub

Get the characters to the left of the first numeric digit:

Function TextPart(Str)
    TextPart = ""
    For i = 1 To Len(Str)
        If IsNumeric(Mid(Str, i, 1)) Then
            Exit For
        Else
            TextPart = TextPart & Mid(Str, i, 1)
        End If
    Next i
End Function

Do-While loop

Sub DoWhileDemo()
    Do While ActiveCell.Value <> Empty
        ActiveCell.Value = ActiveCell.Value * 2
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

Do-Until loop

Sub DoUntilDemo()
    Do Until IsEmpty(ActiveCell.Value)
        ActiveCell.Value = ActiveCell.Value * 2
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

For Each-Next loop

Sub DeleteEmptySheets()
    Dim WkSht As Worksheet
    Application.DisplayAlerts = False
    For Each WkSht In ActiveWorkbook.Worksheets
        If WorksheetFunction.CountA(WkSht.Cells) = 0 Then
            WkSht.Delete
        End If
    Next WkSht
    Application.DisplayAlerts = True
End Sub

Event-handler procedures

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        Target.Offset(0, 1) = Now
    End If
End Sub

Other example:

Private Sub Workbook_Open()
    Dim Msg As String
    If Weekday(Now) = 6 Then
        Msg = "Today is Friday. Don’t forget to "
        Msg = Msg & "submit the TPS Report!"
        MsgBox Msg
    End If
End Sub

Other example which utilizes the Windows registry to store data:

Private Sub Workbook_Open()
    Dim Cnt As Long
    Cnt = GetSetting("MyApp", "Settings", "Open", 0)
    Cnt = Cnt + 1
    SaveSetting "MyApp", "Settings", "Open", Cnt
    MsgBox "This workbook has been opened " & Cnt & " times."
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment