Excel VBA Macro

Recently I had to design a user interface for one of our clients and wasn't certain that we were on the same page; I decided that the absolute best way to ensure we were both speaking kiwis to kiwis and not apples to oranges I decided that mocking a large dataset in excel and use conditional formatting to really demonstrate which records would be filtered and what proportion of the data would be used in the data visualization. 

to get started I first had to enable the developer tab in the ribbon, I did this this by going to the file tab and hitting the options button.

with the Developer tab in place, I created a generate data macro

Now I already have my macro created, but what if i didn't then the create button would be enabled

once you enter in a name for your macro and hit the create button, the VBA environment straight from 2003 will pop right up

Try not to fear this relic; it brings me back to days of Visual basic 6... 

this will be your IDE... under the view dropdown menu you can open your Immediate window were you can do console logs or in this case Debug.Print statements and the locals for debugging variables.

now the thing to remember is that this is a slightly different paradigm than OOP, this is more functional; you have the concept of modules which is sorta kinda like classes, but not really. 

anyway the way I set my macro up is that I create sub procedures that will do things for me, however sub procedures do not return values, there are functions, but I Find that declaring globals that sub procedures manipulate just seems to work better than functions.

so lets get started,

Option Explicit

Dim recordCount As Integer
Dim dimensions As Variant
Dim communities As Variant
Dim radars As Variant

Sub GenerateData()

End Sub

Above I created my main macro "GenerateData" (I realize in the screenshot is says GenderateData, that my dear friends was a typo) and i set up some global variables that my subprocedures will populate,

firstly lets create a private sub procedure that will get the number of records we want to collect and store it in our recordCount global variable. the rational for it being private is that it is useless by itself so as not to pollute the macro list we mark it as private so that it doesn't appear in the list of macros.

Private Sub GetRecordCount()
    recordCount = Application.InputBox("How many records would you like to generate?")
    Debug.Print "Records to create: " & recordCount
End Sub

Here we simply popup a input box and take in an import, this input comes in as a string so in theory we should do some type checking, but this is a tool for developers not idiots business analysts. 

then in our immediate window we will see our debug text

this is a great way of debugging our script.

next let's create a sub Procedure to generate the header for our data.

Sub GenderateHeader()

    Dim i As Integer

    Dim Headers As Variant

    Headers = Array("Id", "Community", "Radar", "Gender", "Age", "Household Size", "Education", "Dimension", "Subdimension", "Value")

    

    For i = 1 To UBound(Headers) + 1

        Cells(1, i).Value = Headers(i - 1)

        Cells(1, i).Font.Bold = True

        Debug.Print "Created '" & Headers(i - 1) & "' Header"

    Next i

End Sub

The above code creates a variable i which we will use to iterate over our array with, and a headers array containing all of the header names we want to print out.

now the for loop; the syntax is a bit quirky but in essence it just takes the variable i and iterates it in this case from 1 to the upperbound index of our header + 1

the reasons we start from 1 and not 0 is because the cells function takes in two numbers, the first is the row and the second is the column; as depicted in the table below

1,1	1,2	1,3
2,1	2,2	2,3
3,1	3,2	3,3

this is why we start with 1 and just subtract one since our array is 0 based;

now lets add these two procedures to our main procedure

Option Explicit

Dim recordCount As Integer
Dim dimensions As Variant
Dim communities As Variant
Dim radars As Variant

Sub GenerateData()
    Call GetRecordCount
    Call GenderateHeader
End Sub

And that is it now if we call our macro we will get the number of records to create and generate a header; we still have no data but at least we know how much data to create. however before we create our data let's populate our global variables, since we will need them to generate our data records. We'll start with radars and communities since they are much easier.

Private Sub PopulateCommunities()

    communities = Array("Bell River", "Lasalle", "Leamington", "Tecumseh", "Windsor")

End Sub

Private Sub PopulateRadars()

    radars = Array("Baseline", "Midline", "Endline")

End Sub

like I said simple, we just create arrays with some static values, no big deal, 

Now for the hard part, now we don't have objects in VBA but we do have modules which can sort of be used in the same way. What we need is a simple object with a name and a list of subdimensions, you could think of it as a jagged array, which may have been an easier to implement this concept however i opted to use a module.

click the insert button and create a class module, I named it c_Dimension; dimension being the domain specific name and c_ denotating that it is a class module. you can modify the name of the module in the properties window of the module itself, if you are wondering why mine isn't called module1

next lets write some code

Dim cName As String

Dim cSubDimensions As Variant

'name properties

Public Property Get name() As String

    name = cName

End Property

Public Property Let name(name As String)

    cName = name

End Property

'subdimension properites

Public Property Get subDimensions() As Variant

    subDimensions = cSubDimensions

End Property

Public Property Let subDimensions(subDimension As Variant)

    cSubDimensions = subDimension

End Property

'initialization

Public Sub Init(name As String, subDimensions As Variant)

    cName = name

    cSubDimensions = subDimensions

    Debug.Print "Created '" & name & "' dimension with " & UBound(subDimensions) & " subdimensions"

End Sub

• ok so first thing we do is create two private variables to store the name and the subdimensions of the object
• next we create public get and let property accessors, this lets us read and write to our private properties.
• then finally we create an init function, this is because modules do not have what we would consider a constructor where you can pass parameters, we could have simply used the let statements, but this is just a preference of mine.

now that we have our "Class Module" built lets go back to our "Module" and create a function that populates our dimensions array with instances of our c_dimension class module. 

we create our populateDimensions sub procedure

Private Sub PopulateDimensions()

    'Health

    Dim Health As c_Dimension

    Set Health = New c_Dimension

    Health.Init "Health", Array("Access", "Knowledge", "Enviroment", "Practice", "Disease Control", "Maternal & Child Health")

    

    'Risk

    Dim Risk As c_Dimension

    Set Risk = New c_Dimension

    Risk.Init "Risk", Array("Early Action", "Climate Change", "Household DDR practices", "Community Preparedness", "Community Risk Reduction", "Maternal & Child Health")

    

    'Wash

    Dim Wash As c_Dimension

    Set Wash = New c_Dimension

    Wash.Init "Wash", Array("Water Access", "Sanitation", "Hygiene", "Safe water", "Water Storage", "Maternal & Child Health")

    

    'Shelter

    Dim Shelter As c_Dimension

    Set Shelter = New c_Dimension

    Shelter.Init "Shelter", Array("Access", "Knowledge", "Practice", "Building Regulations")

    

    'Food

    Dim Food As c_Dimension

    Set Food = New c_Dimension

    Food.Init "Food", Array("Food Availability", "Dietary Diversity", "Coping capacity", "Nutrition", "Current Coping Strategies")

    

    dimensions = Array(Health, Risk, Wash, Shelter, Food)

End Sub

above we manually configure each dimension and then at the end we assign them all to the dimensions array.

now we are done with the populate sub procedure we can call them from our macro 

Option Explicit

Dim recordCount As Integer
Dim dimensions As Variant
Dim communities As Variant
Dim radars As Variant

Sub GenerateData()
    Call GetRecordCount
    Call GenderateHeader

    Call PopulateDimensions
    Call PopulateCommunities
    Call PopulateRadars
End Sub

Now we have all of the data we need to start configuring our records; to do that you guessed it we are going to need another for loop, so lets set that up now

Option Explicit

Dim recordCount As Integer
Dim dimensions As Variant
Dim communities As Variant
Dim radars As Variant

Sub GenerateData()
    Call GetRecordCount
    Call GenderateHeader

    Call PopulateDimensions
    Call PopulateCommunities
    Call PopulateRadars

    Dim i As Integer

    Dim dimensionIndex As Integer

    For i = 1 To recordCount

        'generate ID value

        Cells(i + 1, 1).Value = i

        

        'generate data

        

        'generate value

        Cells(i + 1, 10).Value = Round(Rnd, 2)

    Next i

End Sub

we added a for loop to our main macro sub procedure in this for loop we are going to create sub procedures to generate all of our data. we included the population of the ID column, since it is simple enough and the value couple because again simple enough; we used the same cell function with the (row, column) coordinate system, the Rnd procedure returns a random float between 0 and 1 which we try to round to 2 decimal places (though that doesn't seem to work too great, but i dont care enough to figure out why)

now there is about 8 columns worth of data to create, I am only going to go into detail about two of them. one easy and one difficult

an easy one first, since most of the sub procedures will be at about the same level of difficulty 

Private Sub WriteCommunity(row As Integer, col As Integer)

    Dim index As Integer

    index = Int((UBound(communities) + 1) * Rnd)

    Cells(row, col).Value = communities(index)

End Sub

the above just fills in a random community from our communities array, you simply call it from our main macro sub procedure like so

Option Explicit

Dim recordCount As Integer
Dim dimensions As Variant
Dim communities As Variant
Dim radars As Variant

Sub GenerateData()
    Call GetRecordCount
    Call GenderateHeader

    Call PopulateDimensions
    Call PopulateCommunities
    Call PopulateRadars

    Dim i As Integer

    Dim dimensionIndex As Integer

    For i = 1 To recordCount

        'generate ID value

        Cells(i + 1, 1).Value = i

        

        'write community data to record

        WriteCommunity i + 1, 2

        

        'generate value

        Cells(i + 1, 10).Value = Round(Rnd, 2)

    Next i

End Sub

notice that we call our write community sub procedure with a space, the row and then the column, we offset the row by 1 because of the header.

next lets look at creating our dimensions 

Function WriteDimension(row As Integer, col As Integer) As Integer

    Dim index As Integer

    index = Int((UBound(dimensions) + 1) * Rnd)

    Cells(row, col).Value = dimensions(index).name

    WriteDimension = index

End Function

now this for once is a function that returns a value, however notice that there is no return keyword, instead we use this bizarre "WriteDimension = index" syntax to return a value to our main sub procedure.

Option Explicit

Dim recordCount As Integer
Dim dimensions As Variant
Dim communities As Variant
Dim radars As Variant

Sub GenerateData()
    Call GetRecordCount
    Call GenderateHeader

    Call PopulateDimensions
    Call PopulateCommunities
    Call PopulateRadars

    Dim i As Integer

    Dim dimensionIndex As Integer

    For i = 1 To recordCount

        'generate ID value

        Cells(i + 1, 1).Value = i

        

        'write community data to record

        WriteCommunity i + 1, 2

        'write dimension data to record and return dimension index 

        dimensionIndex = WriteDimension(i + 1, 8)

        'generate value

        Cells(i + 1, 10).Value = Round(Rnd, 2)

    Next i

End Sub

the reason we return the dimension index is so that we can pass it to the subdimension write function and we can get the corresponding index to populate the subdimension column with the correct values.

Function WriteSubdimension(row As Integer, col As Integer, dimIndex As Integer)

    Dim index As Integer

    Dim dimension As c_Dimension

    Set dimension = dimensions(dimIndex)

    

    index = Int((UBound(dimensions(dimIndex).subDimensions) + 1) * Rnd)

    Debug.Print "Dimension: " & dimension.name

    Debug.Print "Subdimension: " & dimension.subDimensions(index)

    

    Cells(row, col).Value = dimension.subDimensions(index)

End Function

the important takeaway from this function is that you do not try something like dimensions(1).subDimensions, because it will not work, you really have to create a reference to the dimension then access the subdimensions through that reference.

and of course we have to call the writeSubdimension sub procedure from our main macro 

Option Explicit

Dim recordCount As Integer
Dim dimensions As Variant
Dim communities As Variant
Dim radars As Variant

Sub GenerateData()
    Call GetRecordCount
    Call GenderateHeader

    Call PopulateDimensions
    Call PopulateCommunities
    Call PopulateRadars

    Dim i As Integer

    Dim dimensionIndex As Integer

    For i = 1 To recordCount

        'generate ID value

        Cells(i + 1, 1).Value = i

        

        'write community data to record

        WriteCommunity i + 1, 2

        'write dimension data to record and return dimension index 

        dimensionIndex = WriteDimension(i + 1, 8)

        'write subdimension data to record

        WriteSubdimension i + 1, 9, dimensionIndex

        'generate value

        Cells(i + 1, 10).Value = Round(Rnd, 2)

    Next i

End Sub

Finaly here is the full module followed by the class moduel

start module

Option Explicit

Dim recordCount As Integer

Dim dimensions As Variant

Dim communities As Variant

Dim radars As Variant

Sub GenerateData()

    Call GetRecordCount

    Call GenderateHeader

    Call PopulateDimensions

    Call PopulateCommunities

    Call PopulateRadars

    

    Dim i As Integer

    Dim dimensionIndex As Integer

    For i = 1 To recordCount

        'generate ID value

        Cells(i + 1, 1).Value = i

        WriteCommunity i + 1, 2

        WriteRadar i + 1, 3

        WriteGender i + 1, 4

        WriteAge i + 1, 5

        WriteHouseholdSize i + 1, 6

        WriteEducation i + 1, 7

        dimensionIndex = WriteDimension(i + 1, 8)

        WriteSubdimension i + 1, 9, dimensionIndex

        

        'generate value

        Cells(i + 1, 10).Value = Round(Rnd, 2)

    Next i

    

    Call AddConditionalFormating

End Sub

Private Sub WriteCommunity(row As Integer, col As Integer)

    Dim index As Integer

    index = Int((UBound(communities) + 1) * Rnd)

    Cells(row, col).Value = communities(index)

End Sub

Private Sub WriteRadar(row As Integer, col As Integer)

    Dim index As Integer

    index = Int((UBound(radars) + 1) * Rnd)

    Cells(row, col).Value = radars(index)

End Sub

Private Sub WriteGender(row As Integer, col As Integer)

    If (Int(3 * Rnd) Mod 2 = 0) Then

        Cells(row, col).Value = "M"

    Else

        Cells(row, col).Value = "F"

    End If

End Sub

Private Sub WriteAge(row As Integer, col As Integer)

    Dim age As Integer

    age = Int(100 * Rnd)

    Cells(row, col).Value = Switch(age < 18, "Youth", age < 66, "Adult", age < 100, "Senior")

End Sub

Private Sub WriteHouseholdSize(row As Integer, col As Integer)

    Dim size As Integer

    size = Int(6 * Rnd)

    Cells(row, col).Value = Switch(size = 1, "Single", size < 6, "Medium", size > 5, "High")

End Sub

Private Sub WriteEducation(row As Integer, col As Integer)

    Dim years As Integer

    years = Int(50 * Rnd)

    Cells(row, col).Value = Switch(years < 6, "Basic", years < 11, "Normal", years > 10, "High")

End Sub

Function WriteDimension(row As Integer, col As Integer) As Integer

    Dim index As Integer

    index = Int((UBound(dimensions) + 1) * Rnd)

    Cells(row, col).Value = dimensions(index).name

    WriteDimension = index

End Function

Function WriteSubdimension(row As Integer, col As Integer, dimIndex As Integer)

    Dim index As Integer

    Dim dimension As c_Dimension

    Set dimension = dimensions(dimIndex)

    

    index = Int((UBound(dimensions(dimIndex).subDimensions) + 1) * Rnd)

    Debug.Print "Dimension: " & dimension.name

    Debug.Print "Subdimension: " & dimension.subDimensions(index)

    

    Cells(row, col).Value = dimension.subDimensions(index)

End Function

Private Sub PopulateCommunities()

    communities = Array("Bell River", "Lasalle", "Leamington", "Tecumseh", "Windsor")

End Sub

Private Sub PopulateRadars()

    radars = Array("Baseline", "Midline", "Endline")

End Sub

Private Sub PopulateDimensions()

    'Health

    Dim Health As c_Dimension

    Set Health = New c_Dimension

    Health.Init "Health", Array("Access", "Knowledge", "Enviroment", "Practice", "Disease Control", "Maternal & Child Health")

    

    'Risk

    Dim Risk As c_Dimension

    Set Risk = New c_Dimension

    Risk.Init "Risk", Array("Early Action", "Climate Change", "Household DDR practices", "Community Preparedness", "Community Risk Reduction", "Maternal & Child Health")

    

    'Wash

    Dim Wash As c_Dimension

    Set Wash = New c_Dimension

    Wash.Init "Wash", Array("Water Access", "Sanitation", "Hygiene", "Safe water", "Water Storage", "Maternal & Child Health")

    

    'Shelter

    Dim Shelter As c_Dimension

    Set Shelter = New c_Dimension

    Shelter.Init "Shelter", Array("Access", "Knowledge", "Practice", "Building Regulations")

    

    'Food

    Dim Food As c_Dimension

    Set Food = New c_Dimension

    Food.Init "Food", Array("Food Availability", "Dietary Diversity", "Coping capacity", "Nutrition", "Current Coping Strategies")

    

    dimensions = Array(Health, Risk, Wash, Shelter, Food)

End Sub

Private Sub GetRecordCount()

    recordCount = Application.InputBox("How many records would you like to generate?")

    Debug.Print "Records to create: " & recordCount

End Sub

Sub GenderateHeader()

    Dim i As Integer

    

    Dim Headers As Variant

    Headers = Array("Id", "Community", "Radar", "Gender", "Age", "Household Size", "Education", "Dimension", "Subdimension", "Value")

    

    For i = 1 To UBound(Headers) + 1

        Cells(1, i).Value = Headers(i - 1)

        Cells(1, i).Font.Bold = True

        Debug.Print "Created '" & Headers(i - 1) & "' Header"

    Next i

End Sub

Private Sub AddConditionalFormating()

    Cells.FormatConditions.Delete

    Dim range As String

    Cells.FormatConditions.Add Type:=xlExpression, Formula1:= _

        "=AND(OR($B1=""Bell River"";$B1=""Tecumseh"";$B1=""Windsor"");OR($C1=""Baseline"";$C1=""Midline""); $F1=""Medium""; $G1=""High"")"

    Cells.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    With Selection.FormatConditions(1).Interior

        .PatternColorIndex = xlAutomatic

        .Color = 49407

        .TintAndShade = 0

    End With

    Cells.FormatConditions(1).StopIfTrue = False

End Sub

end module

start class module

Dim cName As String

Dim cSubDimensions As Variant

'name properties

Public Property Get name() As String

    name = cName

End Property

Public Property Let name(name As String)

    cName = name

End Property

'subdimension properites

Public Property Get subDimensions() As Variant

    subDimensions = cSubDimensions

End Property

Public Property Let subDimensions(subDimension As Variant)

    cSubDimensions = subDimension

End Property

'initilisation

Public Sub Init(name As String, subDimensions As Variant)

    cName = name

    cSubDimensions = subDimensions

    Debug.Print "Created '" & name & "' dimension with " & UBound(subDimensions) & " subdimensions"

End Sub

end class module