Option Compare Database
Private Sub mslBox1_Click()
Me.Form.Filter = vSetFilters
Me.Form.FilterOn = True
Me.Form.Refresh
End Sub
Private Sub mslBox2_Click()
Me.Form.Filter = vSetFilters
Me.Form.FilterOn = True
Me.Form.Refresh
End Sub
'Third List Box
Me.Form.Filter = vSetFilters
Me.Form.FilterOn = True
Me.Form.Refresh
End Sub
'Fourth List Box
Me.Form.Filter = vSetFilters
Me.Form.FilterOn = True
Me.Form.Refresh
End Sub
'Fifth List Box
Private Sub mslBox5_Click()
Me.Form.Filter = vSetFilters
Me.Form.FilterOn = True
Me.Form.Refresh
End Sub
Private Sub mslBox6_Click()
'Sixth List Box
Me.Form.Filter = vSetFilters
Me.Form.FilterOn = True
Me.Form.Refresh
End Sub
Public Function vSetFilters() As String
On Error GoTo vSetFilters_Err
' Assign Variables
Dim vIndvSel As String
Dim varItem As Variant
Dim vListBox1, vListBox2, vListBox3, vListBox4, VListBox5, mslBox6 As Control
'Define List Boxes
Set vListBox1 = Me.mslBox1
Set vListBox2 = Me.mslBox2
Set vListBox3 = Me.mslBox3
Set vListBox4 = Me.mslBox4
Set VListBox5 = Me.mslBox5
Set VListBox6 = Me.mslBox6
'1st Multi Select List Box
Select Case vListBox1.ItemsSelected.Count
Case Is = 1
If Len(vIndvSel) >= 1 Then vIndvSel = vIndvSel & " AND "
vIndvSel = vIndvSel & "ABS([tProvID])='"
For Each varItm In vListBox1.ItemsSelected
vIndvSel = vIndvSel & vListBox1.ItemData(varItm) & "'"
Next varItm
Case Is > 1
If Len(vIndvSel) >= 1 Then vIndvSel = vIndvSel & " AND "
vIndvSel = vIndvSel & "ABS([tProvID]) IN ("
i = 0
For Each varItm In vListBox1.ItemsSelected
If i > 0 Then
vIndvSel = vIndvSel & ", "
End If
i = i + 1
vIndvSel = vIndvSel & Chr(34) & vListBox1.ItemData(varItm) & Chr(34)
Next varItm
vIndvSel = vIndvSel & ") "
End Select
'Assign String to Isolate Records
vSetFilters = vIndvSel
'2nd Multi Select List Box
Select Case vListBox2.ItemsSelected.Count
Case Is = 1
If Len(vIndvSel) >= 1 Then vIndvSel = vIndvSel & " AND "
vIndvSel = vIndvSel & "ABS([tPathID])='"
'(Duplicate code as noted above in 1st box)
'3rd Multi Select List Box
code...
'4th Multi Select List Box
code...
'5th Multi Select List Box
code...
'6th Multi Select List Box
Code...
'Assign String to Isolate Records
vSetFilters = vIndvSel
vSetFilters_Exit:
Exit Function
vSetFilters_Err:
code....
Resume vSetFilters_Exit
End Select
End Function
Private Sub bClrFilters_Click()
' Clear all Multi-select List Boxes with a Clear Button Dim iCount As Integer
'mslBox1
For iCount = Me!mslBox1.ListCount To 0 Step -1
Me!mslBox1.Selected(iCount) = False
Next iCount
'mslBox2
For iCount = Me!mslBox2.ListCount To 0 Step -1
Me!mslBox2.Selected(iCount) = False
Next iCount
'mslBox3
For iCount = Me!mslBox3.ListCount To 0 Step -1
Me!mslBox3.Selected(iCount) = False
Next iCount
'mslBox4
For iCount = Me!mslBox4.ListCount To 0 Step -1
Me!mslBox4.Selected(iCount) = False
Next iCount
'mslBox5
For iCount = Me!mslBox5.ListCount To 0 Step -1
Me!mslBox5.Selected(iCount) = False
Next iCount
'mslBox6
For iCount = Me!mslBox6.ListCount To 0 Step -1
Me!mslBox6.Selected(iCount) = False
Next iCount
'Reset the form to show all records
Me.Filter = ""
Me.FilterOn = False
End Sub
Private Sub bClrFilters2_Click()
' Clear all Multi-select List Boxes with a Clear Button
'Attempt to call the bClrFilters macro
DoCmd.RunMacro (bClrFilters) 'Attempt to call macro above
End Sub
Private Sub Form_Open(Cancel As Integer)
'Open form to specific size and location
On Error Resume Next
With DoCmd
.SelectObject acForm, "fAccListMSLBFilter"
.MoveSize 3400, 300, 16150, 11150
End With
With Me.Recordset
.MoveLast
.Move -14
End With
luAccNum = ""
vFilterSpec = ""
luCode = ""
luPath = ""
DoCmd.GoToControl "vFilterSpec"
End Sub
Private Sub bRefresh_Click()
Me.Requery
Me.Refresh
With Me.Recordset
.MoveLast
.Move -14
End With
luAccNum = ""
vFilterSpec = ""
luCode = ""
luPath = ""
DoCmd.GoToControl "bEdit"
DoCmd.RunMacro (bClrFilters) 'Attempt to call macro not working
End Sub