An Excel VBA macro that helps in the study of options

Posted on July 22, 2004 by Dimitrios Kalemis

Among other things, I am interested in the study of Economics, the Stock Exchange and the Derivatives Exchange. I do not care much about speculating, because I consider it to be a form of gamble. My view towards investment is to “never sell”. Of course, this requires making buying decisions with this notion in mind: buying stocks for their dividends, buying property in order to rent it and so on. Buying stocks or property in order sell them may be a gamble and I am not sure I want to do that. (Although, of course, as a counter-argument, I have to say that options are a great tool to help you alleviate risk.) To fully explain my point of view concerning investments would require a blog post of its own, so I should leave this subject here for now. But I always love learning concepts and Economics is a science full of interesting discoveries and inventions. The concepts behind the Stock Exchange and the Derivatives Exchange are important and useful for everyone to learn, and so are a lot of concepts in Microeconomics and Macroeconomics.

The Derivatives Exchange is one of the subjects in Economics that I find particularly interesting. And a big part of the Derivatives Exchange are options. At some point, I bought an excellent book, titled “Getting started in options” by Michael C. Thomsett, in its 3rd edition, published by John Wiley & Sons, Inc., with ISBN 0-471-17758-X. I recommend this book to everyone who wishes to learn about options. It certainly helped me tremendously. I really loved this book and when I read it, I could not wait to try my new-found knowledge. I wanted to experiment with all the new concepts I had learnt (spreads and butterfly spreads and so on). I used Excel to try all the concepts, but what I really wanted was an automated way to calculate prices. What I really wanted was an “options lab”: a program that would allow me to enter one or more options and it would calculate the amounts for me. Since I did not know if such an educational program existed, I decided to create my own. I thought a lot about what programming environment to use and I decided that Excel was the best, because I wanted to display a table of the results and Excel’s grid was perfect for this job.

So I used Excel 97 and I developed a VBA macro that consisted of a userform, a module and a class module. The name of the userform is formInputOptions, the name of the module is not important but let’s call it OptionModule and the name of the class module is OptionClass.

Here is a screenshot of the userform formInputOptions in design mode:

The userform formInputOptions consists of a combobox named comboboxBuySell, a textbox named textboxStrikingPrice, a combobox named comboboxCallPut, a textbox named textboxPremium, a commandbutton named buttonSet, a listbox named listboxList and a commandbutton named buttonCalculate.

The code of the userform formInputOptions follows:

Option Explicit

Private Sub buttonCalculate_Click()
   Dim myObject As OptionClass

   If myCollection.Count <= 0 Then
      MsgBox "You must enter at least one option contract"
      Exit Sub
   End If

   'Code for testing. It is not needed.
   'For Each myObject In myCollection
   '   MsgBox myObject.BuySell & " " & CStr(myObject.StrikingPrice) & " " & myObject.CallPut & " at " & CStr(myObject.Premium)
   'Next myObject

   MousePointer = fmMousePointerHourGlass
   DoEvents

   'Assign the Excel column for each option contract
   Dim ExcelMajor As String
   Dim colcounter As Long
   Dim letterCounter As Long
   ExcelMajor = ""
   letterCounter = 1 'It starts from 1 rather than 0, because 0 is for the first Excel column which will be occupied by the stock prices
   For Each myObject In myCollection
      If letterCounter = 26 Then
         letterCounter = 0
         If ExcelMajor = "" Then
            ExcelMajor = "A"
         Else
         ExcelMajor = Chr(Asc(ExcelMajor) + 1)
         End If
      End If
      myObject.ExcelColumn = ExcelMajor & Chr(letterCounter + Asc("A"))
      letterCounter = letterCounter + 1
   Next myObject

   'Assign the Excel column for the sum
   Dim ExcelColumnForSums As String
   If letterCounter = 26 Then
      letterCounter = 0
      If ExcelMajor = "" Then
         ExcelMajor = "A"
      Else
      ExcelMajor = Chr(Asc(ExcelMajor) + 1)
      End If
   End If
   ExcelColumnForSums = ExcelMajor & Chr(letterCounter + Asc("A"))

   'Find the MinPrice (the minimum stock price for which all option contracts will be calculated)
   Dim firstTimeIn As Boolean
   firstTimeIn = True
   Dim MinPrice As Long
   For Each myObject In myCollection
      If firstTimeIn Then
         firstTimeIn = False
         MinPrice = myObject.SuggestedMinPrice
      End If
      If myObject.SuggestedMinPrice < MinPrice Then
         MinPrice = myObject.SuggestedMinPrice
      End If
   Next myObject

   'Find the MaxPrice (the maximum stock price for which all option contracts will be calculated)
   firstTimeIn = True
   Dim MaxPrice As Long
   For Each myObject In myCollection
      If firstTimeIn Then
         firstTimeIn = False
         MaxPrice = myObject.SuggestedMaxPrice
      End If
      If myObject.SuggestedMaxPrice > MaxPrice Then
         MaxPrice = myObject.SuggestedMaxPrice
      End If
   Next myObject

   'Clear all cells of the active Excel sheet
   Cells.Select
   Selection.ClearContents

   'Fill the first Excel column (it has the stock prices)
   Range("A1").Select
   ActiveCell.FormulaR1C1 = "Price Per Share"
   Dim myCounter As Long
   Dim myDifference As Long
   myDifference = 0
   For myCounter = 2 To MaxPrice - MinPrice + 2
       Range("A" & CStr(myCounter)).Select
       ActiveCell.FormulaR1C1 = MaxPrice - myDifference
       myDifference = myDifference + 1
   Next myCounter

   'Fill the other Excel columns (each Excel column represents an option contract)
   For Each myObject In myCollection
      myObject.CalculateValues MinPrice, MaxPrice
   Next myObject

   'Fill the last Excel column which has the sum of all the option contract columns
   Range(ExcelColumnForSums & "1").Select
   ActiveCell.FormulaR1C1 = "Total Profit"
   For myCounter = 2 To MaxPrice - MinPrice + 2
       Range(ExcelColumnForSums & CStr(myCounter)).Select
       ActiveCell.FormulaR1C1 = "=SUM(RC[-" & CStr(myCollection.Count) & "]:RC[-1])"
   Next myCounter

   'Change the font for the first row
   Rows("1:1").Select
   With Selection.Font
       .Name = "Arial"
       .FontStyle = "Bold Italic"
       .Size = 10
       .Strikethrough = False
       .Superscript = False
       .Subscript = False
       .OutlineFont = False
       .Shadow = False
       .Underline = xlUnderlineStyleNone
       .ColorIndex = xlAutomatic
   End With

   'Adjust the size of all columns
   Cells.Select
   Cells.EntireColumn.AutoFit

   'Set focus on first Excel cell
   Range("A1").Select

   'Clear form and collection
   comboboxBuySell.Text = ""
   comboboxCallPut.Text = ""
   textboxStrikingPrice.Text = ""
   textboxPremium = ""
   listboxList.Clear
   Set myCollection = Nothing

   'Set focus to first entry control, in case the application will be needed again
   comboboxBuySell.SetFocus

   MousePointer = fmMousePointerDefault
   DoEvents

   formInputOptions.Hide
End Sub

Private Sub buttonSet_Click()
   If comboboxBuySell.Text <> "BUY" And comboboxBuySell.Text <> "SELL" Then
      MsgBox "Please enter BUY or SELL"
      Exit Sub
   End If
   If comboboxCallPut.Text <> "CALL" And comboboxCallPut.Text <> "PUT" Then
      MsgBox "Please enter CALL or PUT"
      Exit Sub
   End If
   If Trim(textboxStrikingPrice.Text) = "" Then
      MsgBox "Please enter a Striking Price"
      Exit Sub
   End If
   If Trim(textboxPremium.Text) = "" Then
      MsgBox "Please enter a Premium"
      Exit Sub
   End If

   Dim myObject As New OptionClass
   myObject.BuySell = comboboxBuySell.Text
   myObject.CallPut = comboboxCallPut.Text
   myObject.StrikingPrice = CStr(textboxStrikingPrice.Text)
   myObject.Premium = CStr(textboxPremium.Text)
   myCollection.Add myObject
   Set myObject = Nothing

   listboxList.AddItem comboboxBuySell.Text & " " & CStr(textboxStrikingPrice.Text) & " " & comboboxCallPut.Text & " at " & CStr(textboxPremium.Text)

   comboboxBuySell.Text = ""
   comboboxCallPut.Text = ""
   textboxStrikingPrice.Text = ""
   textboxPremium = ""

   comboboxBuySell.SetFocus
End Sub

Private Sub textboxPremium_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   'Process these keys (by doing nothing)
   If Shift = 0 And KeyCode = 8 Then 'Backspace
   ElseIf Shift = 0 And KeyCode = 9 Then 'Tab
   ElseIf Shift = 0 And KeyCode = 13 Then 'Enter
   ElseIf Shift = 0 And KeyCode = 37 Then 'Left arrow
   ElseIf Shift = 0 And KeyCode = 39 Then 'Right arrow
   ElseIf Shift = 0 And KeyCode = 46 Then 'Del
   ElseIf Shift = 0 And KeyCode >= 48 And KeyCode <= 57 Then 'numbers 0,1,2,3,4,5,6,7,8,9
   ElseIf Shift = 1 And KeyCode = 9 Then 'Shift tab
   ElseIf Shift = 1 And KeyCode = 37 Then 'Shift left arrow
   ElseIf Shift = 1 And KeyCode = 39 Then 'Shift right arrow
   ElseIf Shift = 2 And KeyCode = 67 Then 'Control C
   ElseIf Shift = 2 And KeyCode = 86 Then 'Control V
   ElseIf Shift = 2 And KeyCode = 88 Then 'Control X
   Else
     'Do not process all other key combinations (by setting keycode to 0)
     KeyCode = 0
   End If
End Sub

Private Sub textboxStrikingPrice_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   'Process these keys (by doing nothing)
   If Shift = 0 And KeyCode = 8 Then 'Backspace
   ElseIf Shift = 0 And KeyCode = 9 Then 'Tab
   ElseIf Shift = 0 And KeyCode = 13 Then 'Enter
   ElseIf Shift = 0 And KeyCode = 37 Then 'Left arrow
   ElseIf Shift = 0 And KeyCode = 39 Then 'Right arrow
   ElseIf Shift = 0 And KeyCode = 46 Then 'Del
   ElseIf Shift = 0 And KeyCode >= 48 And KeyCode <= 57 Then 'numbers 0,1,2,3,4,5,6,7,8,9
   ElseIf Shift = 1 And KeyCode = 9 Then 'Shift tab
   ElseIf Shift = 1 And KeyCode = 37 Then 'Shift left arrow
   ElseIf Shift = 1 And KeyCode = 39 Then 'Shift right arrow
   ElseIf Shift = 2 And KeyCode = 67 Then 'Control C
   ElseIf Shift = 2 And KeyCode = 86 Then 'Control V
   ElseIf Shift = 2 And KeyCode = 88 Then 'Control X
   Else
     'Do not process all other key combinations (by setting keycode to 0)
     KeyCode = 0
   End If
End Sub

Private Sub UserForm_Activate()
   comboboxBuySell.Clear
   comboboxBuySell.AddItem "BUY"
   comboboxBuySell.AddItem "SELL"

   comboboxCallPut.Clear
   comboboxCallPut.AddItem "CALL"
   comboboxCallPut.AddItem "PUT"

   'Clear form and collection
   comboboxBuySell.Text = ""
   comboboxCallPut.Text = ""
   textboxStrikingPrice.Text = ""
   textboxPremium = ""
   listboxList.Clear
   Set myCollection = Nothing
End Sub

Private Sub UserForm_Deactivate()
   'Clear form and collection
   comboboxBuySell.Text = ""
   comboboxCallPut.Text = ""
   textboxStrikingPrice.Text = ""
   textboxPremium = ""
   listboxList.Clear
   Set myCollection = Nothing
End Sub

The code of the module OptionModule follows:

Option Explicit

Public myCollection As New Collection

Public Sub StockOptions()
   formInputOptions.Show
End Sub

The code of the class module OptionClass follows:

Option Explicit

Public BuySell As String
Public CallPut As String
Public StrikingPrice As Long
Public Premium As Long
Public ExcelColumn As String

Public Function SuggestedMinPrice() As Long
   Dim Boundary As Long
   Boundary = 5

   If CallPut = "CALL" Then
      SuggestedMinPrice = StrikingPrice - Boundary
   End If

   If CallPut = "PUT" Then
      SuggestedMinPrice = StrikingPrice - Premium - Boundary
   End If
End Function

Public Function SuggestedMaxPrice() As Long
   Dim Boundary As Long
   Boundary = 5

   If CallPut = "CALL" Then
      SuggestedMaxPrice = StrikingPrice + Premium + Boundary
   End If

   If CallPut = "PUT" Then
      SuggestedMaxPrice = StrikingPrice + Boundary
   End If
End Function

Public Sub CalculateValues(ByVal MinPrice As Long, ByVal MaxPrice As Long)
   Dim myArray() As Long
   ReDim myArray(MinPrice To MaxPrice) As Long
   Dim myCounter As Long
   Dim myDifference As Long

   If CallPut = "CALL" And BuySell = "BUY" Then
      'From MinPrice to StrikingPrice, Value = -Premium
      'From StrikingPrice to MaxPrice, Value increases from -Premium
      For myCounter = MinPrice To StrikingPrice Step 1
         myArray(myCounter) = -Premium
      Next myCounter
      myDifference = 0
      For myCounter = StrikingPrice To MaxPrice Step 1
         myArray(myCounter) = -Premium + myDifference
         myDifference = myDifference + 1
      Next myCounter
   End If

   If CallPut = "CALL" And BuySell = "SELL" Then
      'From MinPrice to StrikingPrice, Value = Premium
      'From StrikingPrice to MaxPrice, Value decreases from Premium
      For myCounter = MinPrice To StrikingPrice Step 1
         myArray(myCounter) = Premium
      Next myCounter
      myDifference = 0
      For myCounter = StrikingPrice To MaxPrice Step 1
         myArray(myCounter) = Premium - myDifference
         myDifference = myDifference + 1
      Next myCounter
   End If

   If CallPut = "PUT" And BuySell = "BUY" Then
      'From MaxPrice to StrikingPrice, Value is -Premium
      'From StrikingPrice to MinPrice, Value increases from -Premium
      For myCounter = MaxPrice To StrikingPrice Step -1
         myArray(myCounter) = -Premium
      Next myCounter
      myDifference = 0
      For myCounter = StrikingPrice To MinPrice Step -1
         myArray(myCounter) = -Premium + myDifference
         myDifference = myDifference + 1
      Next myCounter
   End If

   If CallPut = "PUT" And BuySell = "SELL" Then
      'From MaxPrice to StrikingPrice, Value is Premium
      'From StrikingPrice to MinPrice, Value decreases from Premium
      For myCounter = MaxPrice To StrikingPrice Step -1
         myArray(myCounter) = Premium
      Next myCounter
      myDifference = 0
      For myCounter = StrikingPrice To MinPrice Step -1
         myArray(myCounter) = Premium - myDifference
         myDifference = myDifference + 1
      Next myCounter
   End If

   Range(ExcelColumn & "1").Select
   ActiveCell.FormulaR1C1 = BuySell & " " & CStr(StrikingPrice) & " " & CallPut & " at " & CStr(Premium)
   myDifference = MaxPrice
   For myCounter = 2 To MaxPrice - MinPrice + 2
       Range(ExcelColumn & CStr(myCounter)).Select
       ActiveCell.FormulaR1C1 = myArray(myDifference)
       myDifference = myDifference - 1
   Next myCounter
End Sub

When the macro is run, the user is supposed to enter one or more transactions. For each transaction, she should select either BUY or SELL, enter a striking price, select either CALL or PUT, enter a premium and press the button Set. The transaction now appears in the list box under the button Set. The user can enter as many transactions as she wishes. When all transactions have been entered, the user should press the button Calculate and the form will be hidden and a table of the calculated result of all the transactions will be displayed in Excel.

Advertisement

About Dimitrios Kalemis

I am a systems engineer specializing in Microsoft products and technologies. I am also an author. Please visit my blog to see the blog posts I have written, the books I have written and the applications I have created. I definitely recommend my blog posts under the category "Management", all my books and all my applications. I believe that you will find them interesting and useful. I am in the process of writing more blog posts and books, so please visit my blog from time to time to see what I come up with next. I am also active on other sites; links to those you can find in the "About me" page of my blog.
This entry was posted in Development. Bookmark the permalink.