Querying Records in VBA MS Access using Date Range and multiselection in ListBox

[Midzie]

Hi All, if anyone could help me with my codes. I have a form with txtStartDate, txtEndDate, with a listbox lstWorkSLY and a cmdRunExtract button. I wanted to query records filtering txtStartDate to txtEndDate based on the items selected in lstWorkSLY. Here's my code, it is not working when I set Nov. 5, 2008 as my txtStartDate and Nov. 28, 2008 as my txtEndDate still all records with DateX June 1, 2008 to January 2009 appears as my output. I don't know where to place my date range condition. Please help me! Thanks in advance.

Private Sub cmdRunExtract_click() 
 
On Error GoTo Err_cmdRunExtract_click 
Dim db As Database 
Dim qdef As QueryDef 
Dim i As Integer 
Dim strSQL As String 
Dim strWhere As String 
Dim strIN As String 
Dim flgSelectAll As Boolean 
Dim varItem As Variant 
Dim strDateField As String 
Dim strWhereDate As String 
Const strcJetDate = "\#mm\/dd\/yyyy\#" 'do not change it to much your local settings 
 
 
Set db = CurrentDb() 
 
strSQL = "select * from tblSLY" 
strDateField = "[DateX]" 'date field from table tblSLY 
 
'Build the filter string 
If IsDate(Me.txtStartDate) Then 
strWhereDate = "(" & strDateField & ">= " & Format(Me.txtStartDate, strcJetDate) & ")" 
End If 
If IsDate(Me.txtEndDate) Then 
If strWhereDate <> vbNullString Then 
strWhereDate = strWhereDate & " and " 
End If 
strWhereDate = strWhereDate & "(" & strDateField & " < " & Format(Me.txtEndDate + 1, strcJetDate) & ")" 
'end if 
'build the IN string by looping through the list 
For i = 0 To lstWorkSIMMSLY.ListCount - 1 
If lstWorkSLY.Selected(i) Then 
If lstWorkSLY.Column(0, i) = "All" Then 
flgSelectAll = True 
End If 
strIN = strIN & "'" & lstWorkSLY.Column(0, i) & "'," 
End If 
Next i 
 
'Create the WHERE string, and strip off the last comma of the IN string 
strWhere = " where [Natr] in " & _ 
"(" & Left(strIN, Len(strIN) - 1) & ")" 
 
'if ALL was selected in the listbox, don't add the WHERE condition 
If Not flgSelectAll Then 
strSQL = strSQL & strWhere 
End If 
End If 
db.QueryDefs.Delete "qrySLY" 
Set qdef = db.CreateQueryDef("qrySLY", strSQL) 
 
'Open the query, built using the In clause to set the criteria 
DoCmd.OpenQuery "qrySLY", acViewNormal 
 
'Clear listbox selection after running query 
For Each varItem In Me.lstWorkSLY.ItemsSelected 
Me.lstWorkSLY.Selected(varItem) = False 
Next varItem 
 
exit_cmdRunExtract_click: 
Exit Sub 
 
Err_cmdRunExtract_click: 
If Err.Number = 5 Then 
MsgBox "You must make a selection(s) from the list", , "Selection Required!" 
Resume exit_cmdRunExtract_click 
Else 
'Write out the error and exit the sub 
MsgBox Err.Description 
Resume exit_cmdRunExtract_click 
End If 
 
End Sub

[TheSmileyCoder]

I have reviewed your code. No where do you actually add the where condition regarding the dates. It also seems you have commented out a End IF on line 31 then isn't meant to be commented out.

Try stepping through your code, and look at the values as they change, and which "way" the code runs through the IF statements. While the code is running, you can always use the Immediate Pane to check values (and even modify them) by simply writing "? strSQL" to see the value of the string variable strSQL.

I have tried to modify your code, but please don't just copy paste it, look at it, and understand the changes made. I have also added indentation to your code. It helps to make the code more readable, and illustrates the structure and buildup of for example if statements.

Private Sub cmdRunExtract_click()
 
On Error GoTo Err_cmdRunExtract_click
Dim db As Database
Dim qdef As QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim varItem As Variant
Dim strDateField As String
Dim strWhereDate As String
Const strcJetDate = "\#mm\/dd\/yyyy\#" 'do not change it to much your local settings
 
 
Set db = CurrentDb()
 
strSQL = "select * from tblSLY"
strDateField = "[DateX]" 'date field from table tblSLY
 
'Build the filter string
    If IsDate(Me.txtStartDate) Then
        strWhereDate = "(" & strDateField & ">= " & Format(Me.txtStartDate, strcJetDate) & ")"
    End If
 
    If IsDate(Me.txtEndDate) Then
        If strWhereDate <> vbNullString Then
        strWhereDate = strWhereDate & " and "
        End If
        strWhereDate = strWhereDate & "(" & strDateField & " < " & Format(Me.txtEndDate + 1, strcJetDate) & ")"
    End If
 
'build the IN string by looping through the list
    For i = 0 To lstWorkSIMMSLY.ListCount - 1
        If lstWorkSLY.Selected(i) Then
            If lstWorkSLY.Column(0, i) = "All" Then
                flgSelectAll = True
            End If
            strIN = strIN & "'" & lstWorkSLY.Column(0, i) & "',"
        End If
    Next i
 
'Create the WHERE string, and strip off the last comma of the IN string
    strWhere = " where [Natr] in " & "(" & Left(strIN, Len(strIN) - 1) & ")"
 
'if ALL was selected in the listbox, don't add the WHERE condition
    If Not flgSelectAll Then
        strSQL = strSQL & strWhere
    End If
 
    'Check to see if we need to add data where clause
    If strWhereDate <> "" Then
        'We need to add it.
        If flgSelectAll Then
            strSQL = strSQL & " AND " & strWhereDate
            Else
            strSQL = strSQL & " WHERE " & strWhereDate
        End If
    End If
 
    db.QueryDefs.Delete "qrySLY"
    Set qdef = db.CreateQueryDef("qrySLY", strSQL)
 
'Open the query, built using the In clause to set the criteria
    DoCmd.OpenQuery "qrySLY", acViewNormal
 
'Clear listbox selection after running query
    For Each varItem In Me.lstWorkSLY.ItemsSelected
        Me.lstWorkSLY.Selected(varItem) = False
    Next varItem
 
exit_cmdRunExtract_click:
    Exit Sub
 
Err_cmdRunExtract_click:
    If Err.Number = 5 Then
        MsgBox "You must make a selection(s) from the list", , "Selection Required!"
        Resume exit_cmdRunExtract_click
    Else
    'Write out the error and exit the sub
        MsgBox Err.Description
        Resume exit_cmdRunExtract_click
    End If
 
End Sub
 
 
 

[Midzie]

Hi Smiley, I stepped into my codes and I noticed it skipped these codes and error "Item not found in this collection" appeared.

Set qdef = db.CreateQueryDef("qrySLY", strSQL)
 
'Open the query, built using the In clause to set the criteria
DoCmd.OpenQuery "qrySLY", acViewNormal
 
'Clear listbox selection after running query
For Each varItem In Me.lstWorkSLY.ItemsSelected
Me.lstWorkSLY.Selected(varItem) = False
Next varItem
 
exit_cmdRunExtract_click:
Exit Sub

[TheSmileyCoder]

Its been a while since I used the listbox control, but try:

For Each varItem In Me.lstWorkSLY.ItemsSelected 
varItem.Selected = False 
Next varItem 

Remember though, that the For Each will loop through all items in that collection. So there is no need to refernce it again inside the loop.

[Midzie]

Hi Smiley, it's working already. The error "Item not found in the collection" appeared because I didn't yet create a query "qrySLY" from query design. I created it and it's working already. I've chosen your first reply as the best answer. Thanks a lot!

[Midzie]

I just want to ask a follow up question, what if I add another listbox here for filtering records? Is it possible? Another is that if i select "ALL" in the listbox the filtering date range was disregarded, I mean it should find first all records within the date range before selecting "ALL" codes in the listbox. Let's say, i have records from Feb 1 t0 28, 2012 with codes from listbox A, B, C, D, E and ALL. If I set start date - Feb. 1, 2012 and end date - Feb. 14, 2012 and select ALL from listbox, It should display ALL records from Feb. 1, 2012 to Feb. 14, 2012 not ALL records of Feb. 1 to 28, 2012. Thanks in advance!

[NeoPa]

Cascaded Form Filtering explains many of the possibilities, but you have to implement your specific logic. The possibilities are various, but this gives the tools with which you can build your logic.

If what you need is more than this simple direction then you should ask it in a new thread. This one's already answered.