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

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.