Basic VBA

Learning Objectives:

  • What is VBA? Why VBA?
  • Hello World
  • What is function? What is subroutine?
  • How to define variable?
  • VBA Objects
  • Record Macro

What is VBA? Why VBA?

VBA stands for Visual Basic Application. It shares the same syntax as Basic language. Every operation you can perform in Excel using keyboard and mouse can be represented by VBA code. Hence, it allows a lot of flexibility and functionality when using Excel.

VBA improves your logical thinking skills, and prepares you for other programming languages, since it is quite basic and the thinking processes can be applied to other languages (such as R in the next chapter). It is ideal for repetitive tasks (e.g. code a function that will run the same process each time, instead of typing it out manually)

VBA Basics

Visual Basic Editor

First, we need to open Visual Basic Editor (VBE). There are two ways to open VBE: (1) Press ALT+F11 to open the Visual Basic Editor and (2) File > Options > Customize Ribbon > Developer(check the box) Developer Tab > Visual Basic

In the toolbar, select Insert \textgreater Module. Make sure you insert the module into the workbook that you are working on.

Module is the place where you store the code. You can have as many modules as you want. You can put your code into different modules according to the functions they perform.

Hello World

We will use MsgBox function in VBA to create a popup window in Excel to say hello world.

Sub HelloWorld()
     MsgBox ("Hello World! I like VBA!")
End Sub

Variable

Dim is used to define variables. The syntax looks like this:

Dim a As Integer
Dim b As Double
Variable Range
Integer From –32,768 to 32,767
Long From –2,147,483,648 to 2,147,486,647
Single From –3402823E38 to –1.401298E–45 or 1.401298E–45 to 3.402823E38
Double From –1.79769313486232E308 to –4.94065645841247E–324 or 1.79769313486232E308 to 4.94065645841247E–324
Boolean Either 1 or 0
String 1 to 65,400 characters
Array An array is a group of variables
Variant Anything

The following example display the value of variable.

Sub DisplayVar()
Dim a as Integer
    a = 10
    Msgbox("My variable has the value of " & a &".")
End Sub

One useful function of MsgBox is to check if certain sections of your code are running properly.

Subroutine and Function

In terms of the code that you can program inside, a Function and a Sub are similar. The main difference is that a Sub performs a task, but returns no output, while a Function takes in input and returns output.

Our Hello World is an example of Sub. The structure of sub is that it starts with Sub together with the name of the Sub, and it ends with End Sub. The code to run is in between.

Sub Name()
        ---Task 1---
        ---Task 2---
End Sub

Inside a subroutine, we can call other subroutine. The following subroutine calls HelloWorld subroutine twice.

Sub CallAnotherSub()
	Call HelloWorld
	Call HelloWorld
End Sub

The syntax for a function is similar. The structure of function is that it starts with Function together with the name of the Sub, and it ends with End Function. The code to run is in between.

However, two key differences: (1) we have to enter the variable to be processed and its variable type, and (2) we have to tell what is the output of the function.

Function Name( Variable As Variable Type)
    ---Content here---
    Name = .....
End Function

Let us create a simple function that calculate length hypotenuse of a right-angle triangle. To calculate the length hypotenuse, we need to have lengths of the sides. Hence, since sides are number, we use double. Since the formula is square root of sum of squared length of the sides, we will use ^ as power and Sqr as square root function.

Function Hypotenuse(a As Double, b As Double)
    Hypotenuse = Sqr(a ^ 2 + b ^ 2)
End Function

Go to spreadsheet then type =Hypotenus(3,4) into formula of any cell. You should get 5.

We can also call function inside a subroutine. The following subroutine calls the hypotenus function.

Sub MsgFunction()
	Msgbox("Secret is " & ABC(3,4))
End Sub

Recall the spreadsheet example of calculation of EMA. S

A B C
1 n 5
2 beta =2/(A1+1)
3 Date Price EMA(n)
4 02-May-16 10
8 06-May-16 8 =AVERAGE(B4:B8)
9 07-May-16 =$B$2*B9+(1-$B$2)*C8
Function EMA(EMAYes As Double, price As Double, n As Integer)
    beta = 2 / (n + 1)
    EMA = beta * price + (1 - beta) * EMAYes
End Function

We can simplify our spreadsheet using the VBA code as shown below.

A B C
1 n 5
2 beta =2/(A1+1)
3 Date Price EMA(n)
4 02-May-16 10
8 06-May-16 8 =AVERAGE(B4:B8)
9 07-May-16 =EMA(C7,B8,$B$1)

Objects

Objects are special type of variables. In particular, they represent elements of Excel. Common used objects include

  1. cell,
  2. range,
  3. workbook,
  4. worksheet,
  5. active objects,
  6. application and
  7. chart.

To use object, we can use either method or property. Method is an action: activate, select, delete, value, formula, text, clear, copy, paste.

Property is description: name, visible Using a metaphor: If object is noun, method is verb and property is adjective

Collections is an object that contain a group of the same object. For example, Worksheets contains all worksheet objects, and Workbooks contains all workbook objects. To call a particular worksheet, we would call the name of the particular sheet in Worksheets.

Cells

Cells refers to one cell in a range but it is using coordinate instead of R1C1 as cell reference. The syntax is Cells(row, column).

For example, the following sets the second row in the range C2:C5 to value of 3. In the other words, C3 is set to 3.

Sub RangeAndCell()
Range("C2:C5").Cells(2, 1).Value = 3
End Sub

If the worksheet name is not explicitly stated, it is assumed that the code works on the active sheet.

Sub WorkingOnCell()
Cells(1,1).value = 5
End Sub

Offset refers to another cell, taking reference from the current active cell.

Sub CellOffSet()
Cells(1,1) = 5
Cells(1,1).Offset(0,1).Formula = "=A1+1"
Cells(1,1).Offset(1,0).Formula = "=A1+2"
End Sub

Then cell A1 is 5, cell B1 is 6 and cell A2 is 7

Range

Range is a collection of cells.

Sub SheetAndRange()
Worksheets("sheet1").Range("A1").Value = 3
End Sub

This causes the worksheet named sheet1 to have the value 3 in cell A1. If the worksheet name is not explicitly stated, it is assumed that the code works on the active sheet.

The following code shows the formula, value, text property of range.

Sub WorkingOnRange()
Range("A1").Formula = "=RAND()"
Range("B1:E3").Value = 6
Range("A1").Text="3+4"
End Sub

The following code shows how to do copy, paste and paste special (value).

Sub CopyAndPaste()
Range("A1:B5").Formula = "=RAND()"
Range("C1").Formula = "=A1+B1"
Range("C1").Copy 
Range("C2:C5").PasteSpecial
End Sub

The following code shows how to obtain input from the spreadsheet.

Sub GetFromSheet ()
Dim a as Integer
Range("A1").Formula ="=RANDBETWEEN(1,6)"
a = Range("A1").Value
Msgbox(a)
End Sub

Worksheets

Worksheets are what we use in Excel, we can create multiple sheets and give them unique names etc. We can also add new sheets or delete sheets in our VBA code.

Sub AddSheet()
   WorkSheets.Add
   WorkSheets(ActiveSheet.Name).Name = "MySheet"
End Sub

Sub DelSheet()
   Application.DisplayAlerts = False
   WorkSheets("MySheet").Delete
   Application.DisplayAlerts = True
End Sub

We can also activate, rename or hide/unhide worksheets:

Worksheets("sheet1").Activate
Worksheets("sheet1").Delete
Worksheets("sheet2").Select
Worksheets("sheet1").Name="Me"
Worksheets("sheet3").Visible=False
Worksheets.Add

Workbook

Workbook object is essentially one excel file.

Sub WorkBookActiveName()
Workbooks("book1").Activate
MsgBox (Workbooks("book1").ActiveSheet.Name)
End Sub

Application

The following four lines show how to select using application objects. The first line chooses cell A1 in the active 2. The second line chooses the second column (of the active worksheet). The third line chooses the first row (of the active worksheet). The forth line chooses the worksheet with name sheet1.

Application.ActiveSheet.Cells(1,1).Select
Application.Columns(2).Select
Application.Rows(1).Select
Application.Sheets("sheet1").Select

The following shows some actions in spreadsheet. The first line asks the program to redo all calculation for the spreadsheet. The second line perform redo.

Application.Calculate
Application.Undo

Worksheet functions are application objects. They can be used directly. For example, the following three lines of code corresponds to calling COUNT, SUM and AVERAGE functions from the spreadsheet.

Application.WorksheetFunction.Count
Application.WorksheetFunction.Sum
Application.WorksheetFunction.Average

Note that Application. can be omitted. The following function SumAvg that calculates sum of two averages of two input ranges.

Function SumAvg(X as Range, Y as Range)
Dim xavg As Double
Dim yavg As Double
xavg = WorksheetFunction.Average(X)
yavg = WorksheetFunction.Average(Y)
SumAvg = xavg + yavg
End Function

Active Objects

ActiveCell refers to the currently selected cell in your Excel workbook. From there, you can add or delete data from the cell. For example,

Sub WorkingActiveCell()
   ActiveCell.Delete
   ActiveCell.Value = 11
   ActiveCell.text = "Helloworld"
End Sub

The final value in the ActiveCell will be Helloworld. This is because you first deleted whatever was in the cell, then put the value 11 into the cell. After which, you overrode the previous value and put in the word Helloworld into the active cell.

The following shows how to display property of active objects. The first line display a message box that tells the address of the active cell, the second one tells the name of active worksheet, and the second line tells the name of the active workbook (the current file name).

MsgBox (ActiveCell.Address)
MsgBox (ActiveSheet.Name)
MsgBox (ActiveWorkbook.Name)

With

Using a With statement allows you to code more efficiently, especially if you have to keep referring to the same object. The following example shows different properties are set for the cells(1,1).

Sub WithExample()
With Cells(1, 1)
    .Value = 4
    .Interior.Color = RGB(255, 255, 0)
    .Font.Color = RGB(0, 255, 0)
End With
End Sub

The code within the With and End With part is applied to the specified cell, which in this case is Cells(1,1).

Charting

For charting in Excel, there are two methods:

  1. chart sheet and
  2. embedded chart.

Chart Sheet

Chart sheet is a worksheet that only has chart. It is an object in a workbook.

To create a new chart sheet, we use the command Charts.Add. Note that this is similar to adding new worksheet command Worksheets.Add.

Then we need to define data source using .SetSourceData Source:=.

Finally, we need to tell what kind of chart is plotting .ChartType =. For example, line chart is xlLine

Sub NewLineChartSheet()
Dim ChartSheet As Chart
Dim Data As Range
Set ChartSheet = Charts.Add
Set Data = Sheets("Sheet1").Range("A1:B3")
With ChartSheet
    .SetSourceData Source:=Data
    .ChartType = xlLine
End With
End Sub

It is useful to define a chart with name so that we can refer later.

Sub NewNamedChartSheet()
Dim ChartSheet As Chart
Dim Data As Range
Set ChartSheet = Charts.Add
Set Data = Sheets("Sheet1").Range("A1:B30")
With ChartSheet
    .SetSourceData Source:=Data
    .ChartType = xlLine
    .Name = "mychart"
End With
End Sub

The following code changes a property of an existing chartsheet. The following code changes the chart by including additional data.

Sub ChangeChartSheet()
Dim ChartSheet As Chart
Dim Data As Range
Set ChartSheet = Charts("mychart")
Set Data = Sheets("Sheet1").Range("A1:B50")
With ChartSheet
    .SetSourceData Source:=Data
End With
End Sub

Embedded Chart

For the chart to be included in a worksheet, we use ChartObjects.Add instead.

We need to tell which worksheet to place the diagram and the distance from the top and left of spreadsheet as well as width and height

Sub EmbeddedChart()
Dim mychart As Object
Dim Data As Range
Set mychart = Sheets("Sheet1").ChartObjects.Add(Left:=300, Width:=300, Top:=10, Height:=300)
Set Data = Sheets("Sheet1").Range("A1:B3")
With mychart.Chart
    .ChartType = xlLine
    .SetSourceData Source:=Data
End With
End Sub

We can give name to the object but not the chart.

Sub EmbeddedNameChart()
Dim mychart As Object
Dim Data As Range
Set mychart = Sheets("Sheet1").ChartObjects.Add(Left:=300, Width:=300, Top:=10, Height:=300)
Sheets("Sheet1").ChartObjects(1).Name = "mychart"
Set Data = Sheets("Sheet1").Range("A1:B3")
With mychart.Chart
    .ChartType = xlLine
    .SetSourceData Source:=Data
End With
End Sub

The following code changes a property of an existing embedded chart. The following code changes the chart by including additional data.

Sub ChangeEmbeddedChart()
Dim ChartObj As Object
Set ChartObj = Sheets("Sheet1").ChartObjects("Hello")
With ChartObj.Chart
    .SetSourceData Source:=Sheets("Sheet1").Range("A1:D3")
End With
End Sub

Chart Type

Besides line chart, there are many different types of chart. Here are the common types.

Function Chart Type
xlLine line chart
xlColumnClustered Clustered Column (vertical bar chart)
xlBarClustered Clustered bar (horizontal bar chart)
xlPie Pie
xlArea Area chart (line chart but colored area)
xlXYScatter Scatter
xlRadar Radar
xlStockHLC High-Low-Close
xlStockOHLC Open-High-Low-Close (Candle Stick)
xlStockVHLC Volume-High-Low-Close
xlStockVOHLC Volume-Open-High-Low-Close

Data Series

To allow for multiple graphics to be plotted, we need to use seriescollection.

First, to add a new data, we need to say .SeriesCollection.NewSeries. Then, we can define the name, XValues (x) and Values (y).

Sub NewChartSheetMultiple()
Dim ChartSheet As Chart
Dim Time, Data1, Data2 As Range
Set ChartSheet = Charts.Add
Set Time = Sheets("Sheet1").Range("A1:A5")
Set Data1 = Sheets("Sheet1").Range("B1:B5")
Set Data2 = Sheets("Sheet1").Range("C1:C5")
With ChartSheet
    .ChartType = xlLine
    
    .SeriesCollection.NewSeries
    .SeriesCollection(1).Name = "Stock 1"
    .SeriesCollection(1).XValues = Time
    .SeriesCollection(1).Values = Data1
    
    .SeriesCollection.NewSeries
    .SeriesCollection(2).Name = "Stock 2"
    .SeriesCollection(2).XValues = Time
    .SeriesCollection(2).Values = Data2
End With
End Sub

Record Macro

Lastly, to see how to code certain actions in Excel, VBA has this useful function called Record Macro. To access it, in the Developer Tab, press the Record Macro button.

Whatever you do in Excel from then on will be recorded in a macro, which you can later access. To stop recording, click the button again, which should now say Stop Recording. Click on the Visual Basic button (access to VBE) to see your recorded actions in code. This is useful if you know what you want to code, and how to do it in Excel, but you do not know how to code it in VBA.

Macro-enable File

Note that when you save your Excel file, always save it in xlsm format (macro enabled worksheet format), otherwise you will not be able to run your macros when you open the file next time!

Previous