Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Having trouble searching by date (dd/mm/yy) in a custom filter form 1

Status
Not open for further replies.
Mayhem9

Mayhem9

Technical User
Dec 19, 2009
155
0
0
AU
Some years ago MajP was kind enough to let me use a very nice filter in a database I was putting together. I've since adapted this database to serve a hobby of mine and have added a couple of new search parameters. However, I cannot get one of these to work. The field in question is a date (dd/mm/yy) format. I'm sure that the issue I have is with the format (i.e. date), as all the other search features work OK. However, when I select a date from the drop down list, I get a "No records found" error. Here is the code for the filter form:

Code: 
'form filter code by MajP from Tek-Tips ([URL unfurl="true"]http://www.tek-tips.com)[/URL]

Option Compare Database
Public fslTools As FilterSortListBox
Public blnSelect As Boolean

'sorts search results based upon the column heading
Private Sub cmdDate_Click()
fslTools.SortList ("Date, SourceID")
End Sub

Private Sub cmdFilter_Click()
  Me.Visible = False
End Sub

Private Sub cmdDesc_Click()
  fslTools.SortList ("Description, YearID")
End Sub

Private Sub cmdID_Click()
fslTools.SortList ("ToolID")
End Sub

Private Sub cmdLocation_Click()
  fslTools.SortList ("LocationID, YearID")
End Sub

Private Sub cmdMan_Click()
  fslTools.SortList ("ManufacturerID, YearID")
End Sub

Private Sub cmdSelect_Click()
  blnSelect = True
  Me.Visible = False
End Sub

Private Sub cmdSource_Click()
    fslTools.SortList ("SourceID, SubCategoryID,YearID")
End Sub

Private Sub cmdYear_Click()
  fslTools.SortList ("YearID")
End Sub

Private Sub cmdCategory_Click()
  fslTools.SortList ("CategoryID, SubCategoryID,YearID")
End Sub

Private Sub cmdSubCategory_Click()
  fslTools.SortList ("SubCategoryID, YearID")
End Sub

Private Sub Form_Activate()
DoCmd.Maximize
End Sub

Private Sub Form_Close()
  resetValues
End Sub
Public Sub resetValues()
  On Error GoTo errlbl
  Me.qMan1.Value = ""
  Me.qCat1.Value = ""
  Me.qSub1.Value = ""
  Me.qLoc1.Value = ""
  Me.qSrc1.Value = ""
  Me.qYear1.Value = ""
  Me.qDate1.Value = ""
  Exit Sub
errlbl:
  If Err.Number = 2467 Then
    Exit Sub
  Else
    MsgBox Err.Number & Err.Description
  End If
End Sub

Private Sub Form_GotFocus()
DoCmd.Maximize
End Sub

Private Sub Form_Load()
  Set fslTools = New FilterSortListBox
  fslTools.Initialize Me.lstSearch
  resetValues
End Sub

Private Sub qDate1_AfterUpdate()
  fslTools.FilterList (getFilter)
End Sub

Private Sub qMan1_AfterUpdate()
  fslTools.FilterList (getFilter)
End Sub

Private Sub qYear1_AfterUpdate()
  fslTools.FilterList (getFilter)
End Sub

Private Sub qCat1_AfterUpdate()
  fslTools.FilterList (getFilter)
End Sub

Private Sub qLoc1_AfterUpdate()
  fslTools.FilterList (getFilter)
End Sub

Private Sub qSrc1_AfterUpdate()
  fslTools.FilterList (getFilter)
End Sub

Private Sub qSub1_AfterUpdate()
  fslTools.FilterList (getFilter)
End Sub

Private Sub Reset_Click()
  resetValues
  fslTools.unFilterList
End Sub

Private Sub Search_Click()
  Me.Visible = False
End Sub

Private Sub ExitForm_Click()
On Error GoTo Err_ExitForm_Click
    DoCmd.Close acForm, Me.Name
Exit_ExitForm_Click:
    Exit Sub
Err_ExitForm_Click:
    MsgBox Err.Description
    Resume Exit_ExitForm_Click
End Sub

Public Function getFilter() As String
 ' On Error GoTo errLable
  Dim strType As String
  Dim strManufacturer As String
  Dim strSerial As String
  Dim strSet As String
  Dim strSubCategory As String
  Dim strLocation As String
  Dim strSource As String
  Dim strYear As String
  Dim strDate As Date
  Dim andOR As String
  Dim removeEnd As Integer
  
  If Not blnSelect Then
    
    If Me.framAndOr.Value = 0 Then
      andOR = " OR "
      removeEnd = 4
    Else
      andOR = " AND "
      removeEnd = 5
    End If
      
    If Not Trim(Me.qMan1 & " ") = "" Then
        strManufacturer = "[ManufacturerID] = '" & qMan1 & "'" & andOR
    End If
    
    If Not Trim(Me.qCat1 & " ") = "" Then
        strType = "[CategoryID] = '" & qCat1 & "'" & andOR
    End If

    If Not Trim(Me.qSub1 & " ") = "" Then
        strType = "[SubCategoryID] = '" & qSub1 & "'" & andOR
    End If
  
    If Not Trim(Me.qLoc1 & " ") = "" Then
        strLocation = "[LocationID] = '" & qLoc1 & "'" & andOR
    End If
    
    If Not Trim(Me.qSrc1 & " ") = "" Then
        strSource = "[SourceID] = '" & qSrc1 & "'" & andOR
    End If
    
    If Not Trim(Me.qYear1 & " ") = "" Then
        strYear = "[YearID] = '" & qYear1 & "'" & andOR
    End If
    
    If Not Trim(Me.qDate1 & " ") = "" Then
        strYear = "[Date] = #" & Format(Me.[qDate1].Value, "dd\/mm\/yy") & "#" & andOR
    
        
    End If
    getFilter = strType + strManufacturer + strLocation + strSubCategory + strSource + strYear
    getFilter = Left(getFilter, Len(getFilter) - removeEnd)

  Else
    If Not IsNull(lstSearch) Then
      getFilter = "[ToolID] = " & Me.lstSearch
    End If
  End If
  Debug.Print getFilter
  'You may comment this out
  'Debug.Print "Filter Criteria: " & getFilter
  'Exit Function
'errLable:
  'MsgBox Err.Number & "  " & Err.Description
End Function

Here is the Module:

Code: 
Option Compare Database
Option Explicit

'Class Module Name: FindAsYouListBox
'Purpose: Turn any Listbox into a "Find As You Type"  listbox
'Created by: MajP

Private WithEvents mListbox As Access.ListBox
Private WithEvents mForm As Access.Form
Private mFilterString As String
Private mSortString As String
Private mRsOriginalList As DAO.Recordset
Private Sub mListBox_AfterUpdate()
  'Call unFilterList
End Sub
Private Sub mForm_Current()
  Call unFilterList
End Sub

Public Sub FilterList(FilterString As String)
  On Error GoTo errLable
  Dim rsTemp As DAO.Recordset
  Set rsTemp = mRsOriginalList.OpenRecordset
  rsTemp.Filter = FilterString
  Set rsTemp = rsTemp.OpenRecordset
  If rsTemp.RecordCount > 0 Then
    Set mListbox.Recordset = rsTemp
    mListbox.Selected(0) = True
    mListbox.Value = mListbox.Column(0)
  Else
    MsgBox "No Records Found"
    Call unFilterList
  End If
  Exit Sub
errLable:
  If Err.Number = 3061 Then
    MsgBox "Will not Filter. Verify filter string is Correct."
  Else
    MsgBox Err.Number & "  " & Err.Description
  End If
End Sub
Public Sub unFilterList()
  On Error GoTo errLable
  Set mListbox.Recordset = mRsOriginalList
   Exit Sub
errLable:
  If Err.Number = 3061 Then
    MsgBox "Will not Filter. Verify Field Name is Correct."
  Else
    MsgBox Err.Number & "  " & Err.Description
  End If
End Sub
Private Sub Class_Terminate()
    Set mForm = Nothing
    Set mListbox = Nothing
    Set mRsOriginalList = Nothing
End Sub
Public Sub Initialize(theListBox As Access.ListBox)
   On Error GoTo errLabel
  If Not theListBox.RowSourceType = "Table/Query" Then
    MsgBox "This class will only work with a ListBox that uses a Table or Query as the Rowsource"
    Exit Sub
  End If
  Set mListbox = theListBox
  Set mForm = theListBox.Parent
  mForm.OnCurrent = "[Event Procedure]"
  mListbox.AfterUpdate = "[Event Procedure]"
 Set mRsOriginalList = mListbox.Recordset.Clone
 Exit Sub
errLabel:
 MsgBox Err.Number & " " & Err.Description
End Sub

Public Sub SortList(SortString As String)
  Dim rs As DAO.Recordset
  Set rs = mListbox.Recordset
  rs.Sort = SortString
  Set mListbox.Recordset = rs.OpenRecordset
  Set rs = mRsOriginalList
  rs.Sort = SortString
  Set mRsOriginalList = rs.OpenRecordset
End Sub

Any help is greatly appreciated.
 
Sort by date Sort by votes
When you want to Filter by Date, could you share what you get here at the Debug place:

Code: 
...
    getFilter = Left(getFilter, Len(getFilter) - removeEnd)
[blue]
Debug.Print getFilter [/blue]

  Else
...

By the way:

Code: 
If Not Trim(Me.qDate1 & " ") = "" Then
    strYear = "[[red]Date[/red]] = #" & Format(Me.[qDate1].Value, "dd\/mm\/yy") & "#" & andOR
End If

Naming field [red]Date[/red] in the data base is not a good idea since it is a reserved word in Access.


---- Andy

There is a great need for a sarcasm font.
 
Upvote 0 Downvote
Hi Andy,

I am not getting any debug errors in the script. I'm getting a pop-up box whenever I select a date from the dropdown box (qDate1) in the filter form:

Capture_li2urw.jpg


I believe that the module code is generating this but I am not 100% sure.

I'll go through and change the field name Date to something else.
 
Upvote 0 Downvote
OK - I renamed Date to Acquired and qdate1 to qAcq1

Now when I select a date from the qAcq1 drop down, I get a Run Time Error 13 Type Mismatch error, which points at the following line of code:

Code: 
        strAcquired = "[Acquired] = #" & Format(Me.[qAcq1].Value, "dd\/mm\/yy") & "#" & andOR

I've tride a couple of different date formats, including mm/dd/yyyh but I still get the same error. Given we don't use US date format, I'm hoping that I can use dd/mm/yy.

I noticed that in my OP that I had incorrectly coded this line (copied and modified), so it read strYear = instead of strAcquired. As you can tell, I'm out of my depth here...
 
Upvote 0 Downvote
Try this:

Code: 
[blue]Debug.Print Me.[qAcq1].Value[/blue]
strAcquired = "[Acquired] = #" & Format(Me.[qAcq1].Value, "dd\/mm\/yy") & "#" & andOR [blue]
Debug.Print strAcquired [/blue]

And paste here what you see in the Immediate Window from Debug statements




---- Andy

There is a great need for a sarcasm font.
 
Upvote 0 Downvote
Hi Andy,

Thanks for your help. I no longer get the error in that section of the code. It is now further down (red text):

Code: 
If Not Trim(Me.qAcq1 & " ") = "" Then
Debug.Print Me.[qAcq1].Value
strAcquired = "[Acquired] = #" & Format(Me.[qAcq1].Value, "dd\/mm\/yy") & "#" & andOR
Debug.Print strAcquired

    End If
    getFilter = strType + strManufacturer + strLocation + strSubCategory + strSource + strYear
    [COLOR=#FF0000]getFilter = Left(getFilter, Len(getFilter) - removeEnd)[/color]
    Debug.Print getFilter

The intermediate window shows:

Code: 
25/09/16 
[Acquired] = #25/09/16# AND

25/09/16 was the date that I selected from the qAcq1 dropdown list.
 
Upvote 0 Downvote
OK, try this then:

Code: 
If Not Trim(Me.qAcq1 & " ") = "" Then
  Debug.Print Me.qAcq1.Value
  Debug.Print [blue]CDate(Me.qAcq1.Value)[/blue]
  strAcquired = "[Acquired] = #" & [blue]CDate(Me.qAcq1.Value)[/blue] & "#" & andOR
  Debug.Print strAcquired
End If

getFilter = strType + strManufacturer + strLocation + strSubCategory + strSource + strYear
getFilter = Left(getFilter, Len(getFilter) - removeEnd)

And if your field [tt]Acquired[/tt] is set up as Date in your table, that should work.


---- Andy

There is a great need for a sarcasm font.
 
Upvote 0 Downvote
Hi Andy,

Error at same point but now the date shows twice in the intermediate window:

Code: 
25/09/16 
25/09/16 
[Acquired] = #25/09/16# AND

I ran the Tek Tips Documenter and I can confirm that the field is set as a date: Acquired dbDate. Is there anywhere else that I should have specified date or format etc?

Thanks!

 
Upvote 0 Downvote
In the data base, Date is just a number. Your date of 25/09/16 is 42638, today (Oct 19, 2018) is just 43392. How you represent this on the screen to your user is up to you.

So you should be able to do this:
[pre]
strSQL = "SELECT * From MyTable WHERE Acquired = #" & CDate(Me.qAcq1.Value) & "#" [/pre]

And execute the strSQL


---- Andy

There is a great need for a sarcasm font.
 
Upvote 0 Downvote
Stop putting the day first since it doesn't work in queries and filters. As I suggested earlier use M/D/Y or some other format that can't be misunderstood. Take a look at Allen Browne's page.

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016
 
Upvote 0 Downvote
Thanks - I'll give that a go. Unfortunately, we don't use the M/D/Y format for dates, so doing this is going to cause issues.
 
Upvote 0 Downvote
Dates are all stored exactly the same. Do as Allen Browne suggests. He lives in d/m/h land.

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016
 
Upvote 0 Downvote
Thanks dhookom - I am currently reading though that link and trying to make sense of it all. I'll see how I go.
 
Upvote 0 Downvote
I tried adding in the code used in the example by Allen Browne but when I compile the data it returns an error saying "Expected End Function"

Code: 
    If Not Trim(Me.qYear1 & " ") = "" Then
        strYear = "[YearID] = '" & qYear1 & "'" & andOR
    End If
    
    ' Not Trim(Me.qAcq1 & " ") = "" Then
    '    Debug.Print Me.qAcq1.Value
    '    Debug.Print CDate(Me.qAcq1.Value)
    '    strAcquired = "[Acquired] = #" & CDate(Me.qAcq1.Value) & "#" & andOR
    '    Debug.Print strAcquired
    'End If
    [COLOR=#ff0000]<-- error points to here[/color]
Function SQLDate(qAcq1 As Variant) As String
    'Purpose:    Return a delimited string in the date format used natively by JET SQL.
    'Argument:   A date/time value.
    'Note:       Returns just the date format if the argument has no time component,
    '                or a date/time format if it does.
    'Author:     Allen Browne. allen@allenbrowne.com, June 2006.
    If IsDate(qAcq1) Then
        If DateValue(qAcq1) = qAcq1 Then
            SQLDate = Format$(qAcq1, "\#mm\/dd\/yyyy\#")
        Else
            SQLDate = Format$(qAcq1, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
        End If
    End If
End Function

I'm guessing I've placed in the wrong place?
 
Upvote 0 Downvote
You can't stick an entire function definition in between lines of a function or sub. Take the SQLDate function and place it in its own standard module and save it with the name "modDateFunctions". Then just call the function like you would any regular Access function.

[Code vba]strAcquired = "[Acquired] = " & SQLDate(Me.[qAcq1]) & " " & andOR
Debug.Print "strAcquired: " & strAcquired
[/code]


Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016
 
Upvote 0 Downvote
Thanks dhookom,

As you can see, I have no idea what I am doing here! I created a standard module and named it as you recommended. I then added the following to the form to call the module:

Code: 
Private Sub Form_Current()
strAcquired = "[Acquired] = " & SQLDate(Me.[qAcq1]) & " " & andOR
Debug.Print "strAcquired: " & strAcquired
End Sub

I now get a run-time-error 5 Invalid procedure call or argument here:

Code: 
    getFilter = strType + strManufacturer + strLocation + strSubCategory + strSource + strYear
    [COLOR=#ff0000]getFilter = Left(getFilter, Len(getFilter) - removeEnd)[/color]
    Debug.Print getFilter

The intermediate window shows:

Code: 
strAcquired: [Acquired] =
 
Upvote 0 Downvote
Looking at your original code the only place I see a date filter is this section:

Code: 
    [COLOR=#4E9A06]'only date filter I believe[/color]
    If Not Trim(Me.qDate1 & " ") = "" Then
        strYear = "[Date] = [highlight #FCE94F]#" & Format(Me.[qDate1].Value, "dd\/mm\/yy") & "#"[/highlight] & andOR
    End If

After pasting Allen's code in a module, you would replace the code with:

Code: 
    [COLOR=#4E9A06]'only date filter I believe[/color]
    If Not Trim(Me.qDate1 & " ") = "" Then
        strYear = "[Date] = [highlight #FCE94F]" & SQLDate(Me.[qDate1]) & " "[/highlight] & andOR
    End If


Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016
 
Upvote 0 Downvote
Thank you so much dhookom - that works perfectly.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

TomSalvato
  • Locked
  • Question
Getting the Monday date from a week number 1
Replies
2
Views
120
TomSalvato
TomSalvato
breezett93
  • Locked
  • Question
Function that find all controls on a form and puts their tab index in numerical order
Replies
19
Views
200
dhookom
dhookom
TrekBiker
  • Locked
  • Question
Form Data Not Updating
Replies
6
Views
119
dhookom
dhookom
TrekBiker
  • Locked
  • Question
Forcing Form Updates
Replies
2
Views
83
TrekBiker
TrekBiker
JanaLNelson
  • Locked
  • Question
Filter as you type combo box in Access 2
2 3
Replies
54
Views
447
JanaLNelson
JanaLNelson

Part and Inventory Search

Sponsor

Back
Top