SQL report of hazards for selected processes

Question

I've written some code in VBA to help our R&D department. I've moved all of the redundant and static information into a database for them to look up and then generate a report from.

I've attached the btn_OK_Click() Sub from my user form. Once the user clicks the button, the form goes through the list of "Processes" that the user selects from a Listview control in the form. Once it gets the list of processes, it then queries the SS DB to get the pertinent information.

The code works, but when it starts getting into the range of 30 or more "Processes", it slows down. I think it has something to do with how I'm looping through the processes.

Below is the btn_OK_Click() from my Userform and My Process class. Please let me know if I've coded the SQL code as efficiently as I could have.

Private Sub btn_OK_Click()
 'get confirmation
 If MsgBox("Generate Hazard Analasys?", vbYesNo, "Confirm") = vbCancel Then
 Unload Me
 Exit Sub
 End If
 'Set up the connection
 Set HazardConn = New Connection
 Set HazardSet = New Recordset
 'Open the connection to the database
 On Error GoTo FORMCONNECTIONERROR
 HazardConn.Open CONNSTRING
 On Error GoTo 0
 'Declare Variables
 Dim SQLstring As String 'SQL Command, to be built and passed to the database
 Dim processIDs As Collection 'List of process names to be appended to the SQL String
 Dim procID As Variant 'Individual Process Name
 Dim hazardList As ListObject 'Table (Found in the "Hazard Analysis" Worksheet)
 Dim newProcess As Process 'Process Class - holds all relevant Process attributes
 Dim selRow As Long 'Individual row in the ListView of the form
 'Disable Screen updating, calculation and events
 OptimizeSpeed
 'Initialize
 Set processIDs = New Collection
 On Error GoTo TABLENOTFOUNDERROR
 Set hazardList = HazardSheet.ListObjects("tbl_Hazard")
 On Error GoTo 0
 'Reset the List
 On Error Resume Next
 hazardList.DataBodyRange.Rows.Delete
 On Error GoTo 0
 'Initialize the SQL String
 SQLstring = "SELECT * FROM dbo.Hazard_List WHERE ProcessName IN("
 'Append the SQL String and list the Process Names
 On Error GoTo GENERATEDLISTERROR
 With Me.list_Generated
 For selRow = 0 To Me.list_Generated.ListCount - 2
 SQLstring = SQLstring & "'" & .List(selRow) & "', "
 processIDs.Add .List(selRow)
 Next selRow
 SQLstring = SQLstring & "'" & .List(selRow) & "')"
 processIDs.Add .List(selRow)
 End With
 On Error GoTo 0
 'Open the RecordSe
 On Error GoTo FORMCONNECTIONERROR
 HazardSet.Open SQLstring, HazardConn, adOpenStatic, adLockOptimistic, adCmdText
 On Error GoTo 0
 'Add the Processes to the Hazard Analysis Table
 For Each procID In processIDs
 'Initialize the Process class
 Set newProcess = New Process
 newProcess.ProcessID = procID
 'Filter the recordset by the Process Name
 HazardSet.Filter = "ProcessName = '" & procID & "'"
 'Loop through the filtered records to append all hazards and risks to the Process class
 On Error GoTo RECORDSETREADERROR
 HazardSet.MoveFirst
 Do Until HazardSet.EOF
 'Declare local variables
 Dim hazType As String 'Hazard type (Biological, Chemical, Physical)
 Dim hazName As String 'Description of the hazard
 Dim hazRisk As Boolean 'Indicates if the hazard is a risk
 Dim hazJustify As String 'Justification for the hazard risk
 Dim hazPrevent As String 'Control Measures applied to the hazard
 Dim ccp As Boolean 'CCP Indicator
 'Initialize local variables
 hazType = Mid(CStr(HazardSet("HazardType").Value), 1, 1)
 hazName = HazardSet("HazardName")
 hazRisk = IIf(IsNull(HazardSet("RiskToConsumer")) Or HazardSet("RiskToConsumer") = 0, False, True)
 hazJustify = IIf(IsNull(HazardSet("Justification")), "", HazardSet("Justification"))
 hazPrevent = IIf(IsNull(HazardSet("ControlMeasure")), "", HazardSet("ControlMeasure"))
 ccp = IIf(IsNull(HazardSet("CCP")) Or HazardSet("CCP") = 0, False, True)
 'Pass information into the Process class to be appended to its individual attributes
 newProcess.AddHazard hazType, hazName, hazRisk, hazJustify, hazPrevent
 HazardSet.MoveNext
 Loop
 On Error GoTo 0
 'Add the entire process to the Hazard Table
 On Error GoTo LOADTABLEERROR
 With hazardList
 .ListRows.Add
 .ListColumns(2).DataBodyRange(.ListRows.Count).Value = newProcess.ProcessID
 .ListColumns(3).DataBodyRange(.ListRows.Count).Value = newProcess.Hazards
 .ListColumns(4).DataBodyRange(.ListRows.Count).Value = newProcess.Risks
 .ListColumns(5).DataBodyRange(.ListRows.Count).Value = newProcess.Justifications
 .ListColumns(6).DataBodyRange(.ListRows.Count).Value = newProcess.Preventions
 .ListColumns(7).DataBodyRange(.ListRows.Count).Value = IIf(ccp, "Yes", "No")
 .ListColumns(1).DataBodyRange(.ListRows.Count).EntireRow.AutoFit
 End With
 On Error GoTo 0
 Next procID
 '''''''''''''
 '''CLEANUP'''
 '''''''''''''
 'Unload the form
 Unload Me
 'Dispose of the Connections
 HazardSet.Close
 HazardConn.Close
 Set HazardSet = Nothing
 Set HazardConn = Nothing
 'Reenable screen updating, calculation and events
 ResetApp
 Exit Sub
'Connection error - Will exit the sub if we cannot connect to the database
FORMCONNECTIONERROR:
 MsgBox "There was an error connecting to the database. Please consult your designated support professional", vbCritical, "Error"
 Debug.Print "Connection Error: " & Err.Number & " - " & Err.Description
 Set HazardConn = Nothing
 Set HazardSet = Nothing
 ResetApp
 Exit Sub
'Table not found error - Will unload the form if the table has been renamed or deleted
TABLENOTFOUNDERROR:
 MsgBox "The Table that houses all Processes has been either renamed or deleted. Please consult your designated support professional", vbCritical, "Error"
 Debug.Print "Table Not Found Error: " & Err.Number & " - " & Err.Description
 Set HazardConn = Nothing
 Set HazardSet = Nothing
 ResetApp
 Unload Me
 Exit Sub
'Generated List Error - Will exit the sub if the Generated List is blank, or throws some other errors
GENERATEDLISTERROR:
 MsgBox "Error getting generated list", vbExclamation, "Error"
 Debug.Print "Generated List Error: " & Err.Number & " - " & Err.Description
 Set HazardConn = Nothing
 Set HazardSet = Nothing
 ResetApp
 Exit Sub
'Recordset reading error - Will exit the sub if there was an issue reading the SQL Query
RECORDSETREADERROR:
 MsgBox "There was an error loading the Processes. Please consult your designated support professional", vbCritical, "Error"
 Debug.Print "Recordset Error: " & Err.Number & " - " & Err.Description
 Set HazardConn = Nothing
 Set HazardSet = Nothing
 ResetApp
 Exit Sub
'Load table error - Will exit the sub if there was an issue loading the table
LOADTABLEERROR:
 MsgBox "There was an error filling the table", vbCritical, "Error"
 Debug.Print "Load Table Error: " & Err.Number & " - " & Err.Description
 Set HazardConn = Nothing
 Set HazardSet = Nothing
 ResetApp
 Exit Sub
End Sub

Process Class:

Private procID As String
Private hazardString As String
Private riskString As String
Private justString As String
Private preventString As String
Private procCCP As Boolean
Private bioCount As Long
Private chemCount As Long
Private physCount As Long
Public Property Get ProcessID() As String
 ProcessID = procID
End Property
Public Property Let ProcessID(val As String)
 procID = val
End Property
Public Property Get Hazards() As String
 Hazards = hazardString
End Property
Public Property Let Hazards(val As String)
 hazardString = val
End Property
Public Property Get Risks() As String
 Risks = riskString
End Property
Public Property Let Risks(val As String)
 riskString = val
End Property
Public Property Get Justifications() As String
 Justifications = justString
End Property
Public Property Let Justifications(val As String)
 justString = val
End Property
Public Property Get Preventions() As String
 Preventions = preventString
End Property
Public Property Let Preventions(val As String)
 preventString = val
End Property
Public Property Get ccp() As Boolean
 ccp = procCCP
End Property
Public Property Let ccp(val As Boolean)
 procCCP = val
End Property
Public Sub Init(id As String, c As Boolean)
 procID = id
 bioCount = 0
 chemCount = 0
 physCount = 0
 procCCP = c
End Sub
Public Sub AddHazard(hazType As String, hazName As String, hazRisk As Boolean, hazJustify As String, hazPrevent As String)
 Dim hazRiskString As String
 Dim cString As String
 Dim cCount As Long: cCount = 0
 Dim newLine As Boolean
 hazRiskString = IIf(hazRisk, "Yes", "No")
 newLine = True
 Select Case hazType
 Case "B":
 bioCount = bioCount + 1
 cCount = bioCount
 Case "C":
 chemCount = chemCount + 1
 cCount = chemCount
 Case "P":
 physCount = physCount + 1
 cCount = physCount
 newLine = False
 End Select
 cString = hazType & cCount
 appendStrings cString, hazName, hazRiskString, hazJustify, hazPrevent, newLine
End Sub
Private Sub appendStrings(catString As String, hazName As String, hazRiskString As String, hazJustify As String, hazPrevent As String, addNewLine As Boolean)
 Dim newLine As String: newLine = IIf(addNewLine, vbNewLine, "")
 If Not hazName = "None Identified" Then
 hazardString = hazardString & catString & " - " & hazName & newLine
 riskString = riskString & catString & " - " & hazRiskString & newLine
 If Not hazJustify = vbNullString Then
 justString = justString & catString & " - " & hazJustify & newLine
 End If
 If Not hazPrevent = vbNullString Then
 preventString = preventString & catString & " - " & hazPrevent & newLine
 End If
 End If
End Sub

• jDave1984: I can post any other sub from the Userform if needed. Also side-note: The HazardConn connection and HazardSet recordset variables are all global
• user109261: Why are you filtering the Recordset? Do you need the results returned in a specific order?
• jDave1984: That's the precise reason I'm filtering it.
• user109261: You can avoid having to filter the Recordset by changing processIDs from a Collection to a Scripting Dictionary. You would then add the procID as a key and newProcess as the value. In this way, you could lookup the newProcess by its procID. If you go this route it would be advantages to change the Recordset 's CursorType to adOpenForwardOnly.
• jDave1984: ::flies off to google adOpenForwardOnly

Answer 1

Consistency and Naming

In VBA underscores in Sub and Function names are reserved for inheritance. Since binding a action to a control is generally not related to inheritance, btn_OK_Click should be named okClick or OkClick, depending on whichever you prefer.

I assume you do have Option Explicit specified. If not, you should fix that pronto to avoid bugs when misspelling variables.

obtw: SQLstring should probably be named something like sqlQuery. That avoids repeating the typename and is a bit more explicit. SQL could also be a data definition statement or an update.

In addition I highly recommend renaming the fields of Process to not include the type and not be shortcuts. It's just much easier to read that way:

Private processId As String
Private hazards As String
Private risks As String
Private justifications As String
Private preventions As String
Private cpp As Boolean ' no clue what this stands for...
Private biologicalCount As Long
Private chemicalCount As Long
Private physicalCount As Long

Simplifications

IIf(IsNull(HazardSet("RiskToConsumer")) Or HazardSet("RiskToConsumer") = 0, False, True)
IIf(IsNull(HazardSet("CCP")) Or HazardSet("CCP") = 0, False, True)

this is equivalent to:

Not IsNull(HazardSet("RiskToConsumer")) And HazardSet("RiskToConsumer") <> 0
Not IsNull(HazardSet("CPP")) And HazardSet("CPP") <> 0

Note that I'm pretty sure that your handling of cpp is a bug. You currently only consider the last Record's value of "CPP". That seems not like it's intended that way. Instead you most likely want to have CPP stay on if it's been on once. If that's the case you should change that assignment to:

cpp = cpp Or ([...])

I did notice that you never seem to use Process.Init. If you do use it somewhere else, you can disregard what I said, but you should remove members that are not used.

Repetition

There is significant repetition in how you handle errors. The only thing that's really different is the message in the Message box and the Debug.Print statement.

You should really consider the following:

CLEANEXIT:
 Unload Me
 HazardSet.Close
 HazardConn.Close
 Set HazardSet = Nothing
 Set HazardConn = Nothing
 ResetApp
 Exit Sub
FORMCONNECTIONERROR:
 MsgBox [...]
 Debug.Print [...]
 Resume CLEANEXIT
TABLENOTFOUNDERROR:
 MsgBox [..]
 Debug.Print [..]
 Resume CLEANEXIT
' I think you get the gist ;)

Readability

Last but not least I should mention that the current implementation is somewhat hard to read, because there is literally no abstraction at all in it. It performs a sequence of low-level steps, laid out in somewhat excruciating detail.

I can higly recommend reading this small analogy on what this does when trying to read the code.

• jDave1984: I do have Option Explicit on. Sorry for not including that in the code. The btn_OK_Click Sub was auto-generated. I rarely change the auto-generated sub names just out of habit. Thanks for the other notes. Did you have any help on the specific problem I'm having (i.e. the code takes 8 minutes for 53 items)?
• Vogel612: You should check whether the performance bottleneck is in fact the VBA code or the Database. Have you tried running the quer(y|ies) you're generating against the database manually and timed that? Do you have an index on ProcessName?
• jDave1984: The bottleneck I'm hitting is definitely the filtering of the HazardSet. I'm wondering if there's a better way of handling those without outsourcing the job to a multithread-capable DLL
• Vogel612: given that you're iterating over the Hazard sets in the first place... why not generate a query for each of the Hazards themselves? That'd remove the VBA-side filtering of the recordset and should speed things up a bit. IN is a slow operation in the first place...
• jDave1984: I wonder how long it will take to send 53 queries. Can't take any more than a second, right? ;)