Public Sub createFilter()
Dim strType As String
Dim strCritical As String
Dim strScope As String
Dim strRRB1 As String
Dim strRRB2 As String
Dim strArea As String
Dim strKPP
Dim strFilter As String
Dim itm As Variant
'Filter by Type
For Each itm In Me.lstFilterByType.ItemsSelected
If strType = "" Then
strType = "strRequirementType_Threshold_Objective = '" & Me.lstFilterByType.ItemData(itm) & "'"
Else
strType = strType & " OR strRequirementType_Threshold_Objective = '" & Me.lstFilterByType.ItemData(itm) & "'"
End If
Next itm
If Not strType = "" Then
strType = " (" & strType & ") AND "
End If
'Filter by Critical
For Each itm In Me.lstFilterByCritical.ItemsSelected
If strCritical = "" Then
strCritical = "blnCriticalRequirement = " & Me.lstFilterByCritical.ItemData(itm)
Else
strCritical = strCritical & " OR blnCriticalRequirement = " & Me.lstFilterByCritical.ItemData(itm)
End If
Next itm
If Not strCritical = "" Then
strCritical = "(" & strCritical & ") AND "
End If
'Filter by scope
For Each itm In Me.lstFilterByScope.ItemsSelected
If strScope = "" Then
strScope = "inScope = " & Me.lstFilterByScope.ItemData(itm)
Else
strScope = strScope & " OR inScope = " & Me.lstFilterByScope.ItemData(itm)
End If
Next itm
If Not strScope = "" Then
strScope = " (" & strScope & ") AND "
End If
'Filter by RRB1 resolution
For Each itm In Me.lstRRB1.ItemsSelected
If strRRB1 = "" Then
strRRB1 = "strResults = '" & Me.lstRRB1.ItemData(itm) & "'"
Else
strRRB1 = strRRB1 & " OR strResults = '" & Me.lstRRB1.ItemData(itm) & "'"
End If
Next itm
If Not strRRB1 = "" Then
strRRB1 = " (" & strRRB1 & ") AND "
End If
'Filter by RRB2 Resolution
For Each itm In Me.lstRRB2.ItemsSelected
If strRRB2 = "" Then
strRRB2 = "strRRB2Results = '" & Me.lstRRB2.ItemData(itm) & "'"
Else
strRRB2 = strRRB2 & " OR strRRB2Results = '" & Me.lstRRB2.ItemData(itm) & "'"
End If
Next itm
If Not strRRB2 = "" Then
strRRB2 = " (" & strRRB2 & ") AND "
End If
'Filter by KPP
For Each itm In Me.lstFilterByKPP.ItemsSelected
If strKPP = "" Then
strKPP = "isKPP = " & Me.lstFilterByKPP.ItemData(itm)
Else
strKPP = strKPP & " OR isKPP = " & Me.lstFilterByKPP.ItemData(itm)
End If
Next itm
If Not strKPP = "" Then
strKPP = "(" & strKPP & ") AND "
End If
'Filter by Area
For Each itm In Me.lstFilterByArea.ItemsSelected
If strArea = "" Then
strArea = "strFunctionalArea = '" & Me.lstFilterByArea.ItemData(itm) & "'"
Else
strArea = strArea & " OR strFunctionalArea = '" & Me.lstFilterByArea.ItemData(itm) & "'"
End If
Next itm
If Not strArea = "" Then
strArea = " (" & strArea & ") AND "
End If
strFilter = strType & strCritical & strScope & strRRB1 & strRRB2 & strKPP & strArea
If Not strFilter = "" Then
strFilter = Left(strFilter, Len(strFilter) - 5)
End If
'Debug.Print strFilter
Me.FilterOn = False
Me.Filter = ""
Me.Filter = strFilter
Me.FilterOn = True
If Me.Recordset.RecordCount = 0 Then
Me.FilterOn = False
MsgBox "No Records"
End If
End Sub