VB macro to identify different combinations of cells - vba

Question

I have 4 columns of data.
A is process step
C is Risk number
D is risk rating (high, moderate or low)
F is a risk moderator (control, monitor, test or blank).
I need to populate a presentation with the different combinations.
How many risks have controls and how many do not?
of the ones with controls, how many have monitors or tests, how many do not?
of the ones without controls how many have monitors or tests and how many do not?
within those different categories how many are high, moderate and low?
for the final box those without controls, monitors or tests, what process steps do the risks belong to?
Each risk effectively has a block occupied by column F containing mitigations. There can be several boxes with different items or they can be blank if there are no mitigators.
Below is code that identifies with or without controls but I am stuck on the next sections (counting the different risk ratings and breaking it further into with/without monitoring or testing.
Sub CountWithWithoutControlsv6()
Const RiskColumn As String = "C"
Const ControlColumn As String = "F"
Const StartAtRow As Long = 7
Dim r As Long
Dim ControlFound As Boolean
Dim control As Long
Dim WoControl As Long
Dim lastRow As Long
With ActiveSheet
lastRow = .Range(RiskColumn & .Rows.Count).End(xlUp).row
r = .Range(ControlColumn & .Rows.Count).End(xlUp).row
If lastRow < r Then
lastRow = r
End If
ControlFound = False
For r = StartAtRow To lastRow
If UCase(Trim(CStr(.Cells(r, ControlColumn).Value))) = "CONTROL" Then
ControlFound = True
End If
If Not IsEmpty(.Cells(r + 1, RiskColumn)) Then
'Store info for previous block each time we encounter a new "risk"
If ControlFound Then
control = control + 1
Else
WoControl = WoControl + 1
End If
ControlFound = False
End If
Next
'Store info for final "block"
If ControlFound Then
control = control + 1
Else
WoControl = WoControl + 1
End If
End With
MsgBox control & " = number of risks with controls, " & WoControl & " = number of risks without controls"
End Sub

Answer 1

I'd recommend you "flatten" your data so that column A contains the process step, C is Risk number, D is risk rating (high, moderate or low), F indicates whether a "control" risk moderator exists, G indicates whether a "monitor" risk moderator exists, and H indicates whether a "test" risk moderator exists.
So instead of having data such as
A C D F
Step1 Risk7 High control
monitor
test
Step2 Risk8 Low (blank)
you would instead have
A C D F G H
Step1 Risk7 High Yes Yes Yes
Step2 Risk8 Low No No No
Once in that format, it would be simple to use Excel formulae such as =COUNTIFS(F:F,"Yes",G:G,"Yes",H:H,"No").

Answer 2

If you followed your current approach to this problem you would ultimately achieve your goals - and the code itself would be straightforward to write. However, it would take an awfully long time to write to cover all of your cases and would be mind-numbingly tedious to write. (That you've only produced a few lines of what is, in all honesty, quite a trivial task is probably the reason for your downvote.)
However, before you launch into the remainder of the code, perhaps you would consider using ADO. It's ideally suited to this task and could complete your project in just a few lines. I've no desire to solve your problem for you, but I would like to offer some code to get you started together with a couple of query samples. I've used early binding which means I've referenced the Microsoft ActiveX Data Objects 6.1 Library (Tools ~> References...), but you could late bind if you wish.
Have a look at the code below and see if you could use it:
Dim conn As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim connStr As String
Dim sqlStr As String
Dim tableName As String
Dim procField As String
Dim numField As String
Dim levelField As String
Dim controlField As String
connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='C:\Users\User\Documents\StackOverflow\ADOexample.xlsm';" & _
"Extended Properties=""Excel 12.0;HDR=YES;"";"
'Define the table and field names
With Sheet1 'change to your sheet
tableName = .Name
procField = CStr(.Cells(1, "A").Value)
numField = CStr(.Cells(1, "C").Value)
levelField = CStr(.Cells(1, "D").Value)
controlField = CStr(.Cells(1, "F").Value)
End With
'Open the connection
Set conn = New ADODB.Connection
conn.Open connStr
'Some sample queries
'Sample 1
Set rs = New Recordset
sqlStr = "SELECT * FROM [" & tableName & "$]" & _
" WHERE [" & controlField & "] IS NOT NULL;"
rs.Open sqlStr, conn
Do While Not rs.EOF
Debug.Print rs.Fields(numField)
rs.MoveNext
Loop
'Sample 2
Set rs = New Recordset
sqlStr = "SELECT * FROM [" & tableName & "$]" & _
" WHERE [" & levelField & "] = 'H'" & _
" AND ([" & controlField & "] = 'MONITOR'" & _
" OR [" & controlField & "] = 'TEST');"
rs.Open sqlStr, conn
Do While Not rs.EOF
Debug.Print rs.Fields(numField)
rs.MoveNext
Loop
'Clean up objects
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing