Hi Texan sorry for not replying, I have corrected the code, used your one corrected for the status' added extra status "INVESTIGATED". Added a Year filter and a Issue filter which is "IS LIKE". All of this works and is fine, currently when I change the status filter the other filters dont repopulate with data from the filtered list i.e if I select Overdue, the No filter should only show me no which are overdue. However, What I also wanted was that say if I select two filters e.g. Section and source, I want all the filters to repopulate with records that match this, of course my main screen is already showing these records, but I dont understand why the filters do not. I can remove some information and upload the db if required. Thanks for your help it is much appreaciated. I have attached all the code on the main form below.
Option Compare Database
Option Explicit
Dim strFilter As String
Private Sub Form_Load()
'On open Maximise form
DoCmd.Maximize
'Adjust form to Monitor Resolution
ReSizeForm Me
' Initialize the "OPEN" filter (default value of the Status combo)
strFilter = "(True) And (IsNull([Closed]))"
' Build the filters
ApplyFilters strFilter
End Sub
Private Sub Investigator_AfterUpdate()
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Investigator_DblClick(Cancel As Integer)
Me.Investigator = Null
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Issue_AfterUpdate()
ApplyFilters strFilter
End Sub
Private Sub Issue_DblClick(Cancel As Integer)
Me.Issue = Null
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Method_AfterUpdate()
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Method_DblClick(Cancel As Integer)
Me.Method = Null
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub No_AfterUpdate()
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub No_DblClick(Cancel As Integer)
Me.No = Null
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Ref1_AfterUpdate()
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Ref1_DblClick(Cancel As Integer)
Me.Ref1 = Null
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Section_AfterUpdate()
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Section_DblClick(Cancel As Integer)
Me!Section = Null
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Source_AfterUpdate()
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Source_DblClick(Cancel As Integer)
Me.Source = Null
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Status_AfterUpdate()
' Reset all filters based on the status
Select Case Me.Status
Case "ALL"
' User wants to remove all filters
' Set the filter to include all rows
strFilter = "(True)"
' Call the common code to apply the filter to
' all the combo boxes and the subform
ApplyFilters strFilter
Case "ALL-CLOSED"
' User wants to remove all filters
' Set the filter to include all rows
strFilter = "(True) And (IsNull([Closed]))"
' Call the common code to apply the filter to
' all the combo boxes and the subform
ApplyFilters strFilter
Case "OPEN+OVERDUE"
' Need a definition for this
strFilter = "((IsNull([Authorised])) And (IsNull([Closed])) And (IsNull([Investigated])))"
ApplyFilters strFilter
Case "OPEN"
' User wants only OPEN cases (No Investigated assigned, due date in the future)
' Set the filter
strFilter = "(IsNull([Investigated])) And ([Due Date]>=Date())"
' Call the common code to apply the filter to
' all the combo boxes and the subform
ApplyFilters strFilter
Case "OVERDUE"
' User wants only OVERDUE cases (No Investigated assigned, and due date is in the past)
' Set the filter
strFilter = "(IsNull([Investigated]) And (IsNull([Authorised]) And (IsNull([Closed]) And ([Due Date]<Date()))))"
' Call the common code to apply the filter to
' all the combo boxes and the subform
ApplyFilters strFilter
Case "INVESTIGATED"
' User wants only INVESTIGATED cases (No Investigated, not Closed, and no Authorised and actions open)
' Set the filter
strFilter = "Not (IsNull([Investigated])) And (IsNull([Authorised])) And (IsNull([Closed])) And Not (IsNull([qryActions3.CountOfNo]))"
' Call the common code to apply the filter to
' all the combo boxes and the subform
ApplyFilters strFilter
Case "COMPLETE"
' User wants only COMPLETE cases (No Investigated, not Closed, and no Authorised)
' Set the filter
strFilter = "Not (IsNull([Investigated])) And (IsNull([Authorised])) And (IsNull([Closed]))"
' Call the common code to apply the filter to
' all the combo boxes and the subform
ApplyFilters strFilter
Case "AUTHORISED"
' User wants only AUTHORIZED cases (Investigated assigned, not closed)
' Set the filter
strFilter = " Not (IsNull([Investigated])) And Not (IsNull([Authorised])) And (IsNull([Closed]))"
' Call the common code to apply the filter to
' all the combo boxes and the subform
ApplyFilters strFilter
Case "CLOSED"
' User wants only CLOSED cases (Closed is set)
' Set the filter
strFilter = "Not (IsNull([Investigated])) And Not (IsNull([Authorised])) And Not (IsNull([Closed]))"
' Call the common code to apply the filter to
' all the combo boxes and the subform
ApplyFilters strFilter
End Select
End Sub
Private Sub ApplyFilters(strFilter As String)
Dim strComboFilter As String
Me.YearRange.RowSource = "SELECT DISTINCT [qryYear].[YearA] " & _
"FROM qryYear " & _
"ORDER BY [qryYear].[YearA];"
' If there is a value in No,
If Not IsNull(Me.YearRange) Then
' If the current value of the No control is no longer in the filtered set
If IsNull(DLookup("YearA", "qryYear", _
"([qryYear].[YearA] = " & Me.YearRange & ")")) Then
' Clear the No box
Me.YearRange = Null
End If
End If
' Fix up all the other row sources
Me.No.RowSource = "SELECT DISTINCT [tblInvestigations].[No] " & _
"FROM tblInvestigations " & _
"WHERE " & strFilter & " ORDER BY [No];"
' If there is a value in No,
If Not IsNull(Me.No) Then
' If the current value of the No control is no longer in the filtered set
If IsNull(DLookup("No", "tblInvestigations", _
strFilter & _
" And ([No] = " & Me.No & ")")) Then
' Clear the No box
Me.No = Null
End If
End If
Me.Investigator.RowSource = "SELECT DISTINCT [tblInvestigations].[Investigator] " & _
"FROM tblInvestigations " & _
"WHERE " & strFilter & " ORDER BY [Investigator];"
' If there is a value in Investigator,
If Not IsNull(Me.Investigator) Then
' If the current value of the Investigator control is no longer in the filtered set
If IsNull(DLookup("Investigator", "tblInvestigations", _
strFilter & _
" And ([Investigator] = '" & Me.Investigator & "')")) Then
' Clear the No box
Me.Investigator = Null
End If
End If
Me!Section.RowSource = "SELECT DISTINCT [tblInvestigations].[Section] " & _
"FROM tblInvestigations " & _
"WHERE " & strFilter & " ORDER BY [Section];"
' If there is a value in Section,
If Not IsNull(Me!Section) Then
' If the current value of the Source control is no longer in the filtered set
If IsNull(DLookup("Section", "tblInvestigations", _
strFilter & _
" And ([Section] = '" & Me!Section & "')")) Then
' Clear the No box
Me!Section = Null
End If
End If
Me.Source.RowSource = "SELECT DISTINCT [tblInvestigations].[Source] " & _
"FROM tblInvestigations " & _
"WHERE " & strFilter & " ORDER BY [Source];"
' If there is a value in Source,
If Not IsNull(Me.Source) Then
' If the current value of the Source control is no longer in the filtered set
If IsNull(DLookup("Source", "tblInvestigations", _
strFilter & _
" And ([Source] = '" & Me.Source & "')")) Then
' Clear the No box
Me.Source = Null
End If
End If
Me.Method.RowSource = "SELECT DISTINCT [tblInvestigations].[Method] " & _
"FROM tblInvestigations " & _
"WHERE " & strFilter & " ORDER BY [Method];"
' If there is a value in Method,
If Not IsNull(Me.Method) Then
' If the current value of the No control is no longer in the filtered set
If IsNull(DLookup("Method", "tblInvestigations", _
strFilter & _
" And ([Method] = '" & Me.Method & "')")) Then
' Clear the No box
Me.Method = Null
End If
End If
Me.Ref1.RowSource = "SELECT DISTINCT [tblInvestigations].[Ref1] " & _
"FROM tblInvestigations " & _
"WHERE " & strFilter & " ORDER BY [Ref1];"
' If there is a value in Ref1,
If Not IsNull(Me.Ref1) Then
' If the current value of the No control is no longer in the filtered set
If IsNull(DLookup("Ref1", "tblInvestigations", _
strFilter & _
" And ([Ref1] = '" & Me.Ref1 & "')")) Then
' Clear the No box
Me.Ref1 = Null
End If
End If
' Add back the combo box filters, if any
If Not IsNull(Me.No) Then
strComboFilter = " And ([No] = " & Me.No & ")"
End If
If Not IsNull(Me.YearRange) Then
strComboFilter = strComboFilter & " And (Year([Date Logged]) = '" & Me.YearRange & "')"
End If
If Not IsNull(Me.Issue) Then
strComboFilter = strComboFilter & " And ([Issue] Like '*" & [Forms]![frmMain]![Issue] & "*')"
End If
If Not IsNull(Me.Investigator) Then
strComboFilter = strComboFilter & " And ([Investigator] = '" & Me.Investigator & "')"
End If
If Not IsNull(Me!Section) Then
strComboFilter = strComboFilter & " And ([Section] = '" & Me!Section & "')"
End If
If Not IsNull(Me.Source) Then
strComboFilter = strComboFilter & " And ([Source] = '" & Me.Source & "')"
End If
If Not IsNull(Me.Method) Then
strComboFilter = strComboFilter & " And ([Method] = '" & Me.Method & "')"
End If
If Not IsNull(Me.Ref1) Then
strComboFilter = strComboFilter & " And ([Ref1] = '" & Me.Ref1 & "')"
End If
' Set the subform filter
Me.frmInvestigations.Form.Filter = strFilter & strComboFilter
Me.frmInvestigations.Form.FilterOn = True
' Done
End Sub
Private Sub Status_BeforeUpdate(Cancel As Integer)
strFilter = "(True)"
End Sub
Private Sub AddNewRecords_Click()
On Error GoTo Err_AddNewRecords_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "frmInvForm"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_AddNewRecords_Click:
Exit Sub
Err_AddNewRecords_Click:
MsgBox err.Description
Resume Exit_AddNewRecords_Click
End Sub
Private Sub YearRange_AfterUpdate()
' Rebuild the filters
ApplyFilters strFilter
End Sub
Private Sub Exit_DB_Click()
On Error GoTo Err_Exit_DB_Click
DoCmd.Quit
Exit_Exit_DB_Click:
Exit Sub
Err_Exit_DB_Click:
MsgBox err.Description
Resume Exit_Exit_DB_Click
End Sub
