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
