search code

P

ppoole16

Registered User.
Local time
Today, 21:55
Joined
Aug 21, 2003
Messages
57
I've got a search form based on the following code. After much help from Mile-O-Phile I've been able to get it so that when the user enters an age in an unbound txtbox, a range of +/- 5 years of the date of birth populates 11 unbound txtboxes (each holds a different year.) The below searh works great for everything else, but what I need it to do is look at the populated txtboxes and if one of them matches a person's DOB, then display the results in the results txtbox.

If this doesn't make sense please let me know.

As always, Thanks.

-Phil

http://www.geocities.com/philpoole16

Option Compare Database

Private Sub Clear_Click()
frmSearchForm = vbNullString
lstCustInfo.RowSource = ""
End Sub


Private Sub cmdSearch_Click()
'Set the Dimensions of the Module
Dim strSQL As String, strOrder As String, strWhere As String
Dim dbNm As Database
Dim qryDef As QueryDef
Set dbNm = CurrentDb()



'Constant Select Racement for the RowSource
strSQL = "SELECT BookingSheet.BookingSheetNumber, BookingSheet.First, BookingSheet.Middle, BookingSheet.Last, BookingSheet.Race, BookingSheet.Sex, BookingSheet.DOB, BookingSheet.Height, BookingSheet.Weight, BookingSheet.HairColor, BookingSheet.EyeColor, BookingSheet.ScarsMarksTattoos " & _
"FROM BookingSheet"

strWhere = "WHERE"

strOrder = "ORDER BY BookingSheet.BookingSheetNumber;"


'Set the WHERE clause for the Listbox RowSource if information has been entered into a field on the form
If Not IsNull(Me.txtFirst) Then '<--If the textbox txtFirst contains no data THEN do nothing
strWhere = strWhere & " (BookingSheet.First) Like '*" & Me.txtFirst & "*' AND" '<--otherwise, apply the LIKE statment to the QueryDef
End If

If Not IsNull(Me.txtLast) Then
strWhere = strWhere & " (BookingSheet.Last) Like '*" & Me.txtLast & "*' AND"
End If

If Not IsNull(Me.txtMiddle) Then
strWhere = strWhere & " (BookingSheet.Middle) Like '*" & Me.txtMiddle & "*' AND"
End If

If Not IsNull(Me.txtRace) Then
strWhere = strWhere & " (BookingSheet.Race) Like '*" & Me.txtRace & "*' AND"
End If

If Not IsNull(Me.cmbSex) Then
strWhere = strWhere & " (BookingSheet.Sex) Like '*" & Me.cmbSex & "*' AND"
End If

If Not IsNull(Me.txtHeight) Then
strWhere = strWhere & " (BookingSheet.Height) Like '*" & Me.txtHeight & "*' AND"
End If

If Not IsNull(Me.cmbEyeColor) Then
strWhere = strWhere & " (BookingSheet.EyeColor) Like '*" & Me.cmbEyeColor & "*' AND"
End If

If Not IsNull(Me.cmbHair) Then
strWhere = strWhere & " (BookingSheet.HairColor) Like '*" & Me.cmbHair & "*' AND"
End If

If Not IsNull(Me.smt) Then
strWhere = strWhere & " (BookingSheet.ScarsMarksTattoos) Like '*" & Me.smt & "*' AND"
End If

If Not IsNull(Me.txtmin1) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmin1 & "*' AND"
End If

If Not IsNull(Me.txtmin2) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmin2 & "*' AND"
End If

If Not IsNull(Me.txtmin3) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmin3 & "*' AND"
End If

If Not IsNull(Me.txtmin4) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmin4 & "*' AND"
End If

If Not IsNull(Me.txtmin5) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmin5 & "*' AND"
End If

If Not IsNull(Me.txtmax1) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmax1 & "*' AND"
End If

If Not IsNull(Me.txtmax2) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmax2 & "*' AND"
End If

If Not IsNull(Me.txtmax3) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmax3 & "*' AND"
End If

If Not IsNull(Me.txtmax4) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmax4 & "*' AND"
End If

If Not IsNull(Me.txtmax5) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtmax5 & "*' AND"
End If

If Not IsNull(Me.txtage) Then
strWhere = strWhere & " (BookingSheet.DOB) Like '*" & Me.txtage & "*' AND"
End If

'Remove the last AND from the SQL statment
strWhere = Mid(strWhere, 1, Len(strWhere) - 5)

'Pass the SQL to the RowSource of the listbox

Me.lstCustInfo.RowSource = strSQL & " " & strWhere & "" & strOrder

End Sub



Private Sub lstCustInfo_DblClick(Cancel As Integer)
'Open BookingSheet based on the Booking Sheet Number from lstCustInfo listbox

DoCmd.OpenForm "BookingSheet", , , "[BookingSheetNumber] = " & Me.lstCustInfo, , acDefault

End Sub




Private Sub txtmin2_AfterUpdate()
txtmin2 = (Year(Date) - Me.txtYear) + 2 & " "
End Sub

Private Sub txtmin2_Enter()
txtmin2 = (Year(Date) - Me.txtYear) + 2 & " "
End Sub

Private Sub txtYear_AfterUpdate()

Dim intCounter As Integer, strList As String

If IsNull(Me.txtYear) Then Exit Sub


strList = strList & (Year(Date) - Me.txtYear) + 1 & " "

Me.txtmin1 = Trim(strList)

txtmin2 = (Year(Date) - Me.txtYear) + 2 & " "
txtmin3 = (Year(Date) - Me.txtYear) + 3 & " "
txtmin4 = (Year(Date) - Me.txtYear) + 4 & " "
txtmin5 = (Year(Date) - Me.txtYear) + 5 & " "
txtmax1 = (Year(Date) - Me.txtYear) - 1 & " "
txtmax2 = (Year(Date) - Me.txtYear) - 2 & " "
txtmax3 = (Year(Date) - Me.txtYear) - 3 & " "
txtmax4 = (Year(Date) - Me.txtYear) - 4 & " "
txtmax5 = (Year(Date) - Me.txtYear) - 5 & " "
txtage = (Year(Date) - Me.txtYear) - 0 & " "
End Sub
 
Last edited:
Please

Anyone? I know that's a lot of code, but this is the last problem I need to solve in order to finally be done with this thing.

Thanks again.
-Phil
 
I have two suggestions:

Suggestion 1

Can't you make a calculated field in your query that calculates within the range?

i.e

YearField: Year([DOB])

with the criteria:


Between GetDate(0) And GetDate(-1)

Now, in a module, a public function:

Code: 
Public Function GetDate(ByVal boo As Boolean) As Date
    If boo = 0 Then
        GetDate = Forms!frmMyForm!txtDOBMinus5
    Else
        GetDate = Forms!frmMyForm!txtDOBPlus5
    End If
End Function


Suggestion 2

You database is a normalisation nightmare: non dependant data and repeating groups. ;)

If you are currently developing it then you should really consider taking the time to normalise it so that you won't have problems with it in the future. If you were to break it down into separate areas rather than the whole whack in the one table your form could become more user friendly too. You could then use the tab control on your form and have subforms on each tab so that it resembles a file as if just plucked from a filing cabinet. It also stop the gathering of NULL value cells froming in your table.

P.S. You've spelt Offence incorrectly on your form. ;)
 
I know it's a normalization nightmare. This is my first project and I'd never even heard of normalization prior to reading about it on this site. I have every intention of making an updated version very soon. However I can't quit on this one because I've put so much time into it and my Chief wants something now. I'd much rather give him something quality at a later time rather than this messed up one I have now, but he's the Chief.

By now I know you've figured out that I don't have a clue. Most of what I have is the result of cut and paste. So please walk me through a little more about the following. P.S. I'm going to start some programming classes next semester. Just think, If I can get this db to work, you won't have me asking questions everyday, at least for a few months :)

First off, where is the query? All I did is paste code. The only query I can find is the one that's the row source for lstCustInfo and there's no Year field on that.


Quote:

Can't you make a calculated field in your query that calculates within the range?

i.e

YearField: Year([DOB])
 
Ok, I changed the code on the Search button you have:

Here's what it can be:

Code: 
Private Sub cmdSearch_Click()
    'Set the Dimensions of the Module
    Dim strSQL As String, strOrder As String, strWhere As String
    
    'Constant Select Racement for the RowSource
    strSQL = "SELECT BookingSheet.BookingSheetNumber, BookingSheet.First, BookingSheet.Middle, BookingSheet.Last, BookingSheet.Race, BookingSheet.Sex, BookingSheet.DOB, BookingSheet.Height, BookingSheet.Weight, BookingSheet.HairColor, BookingSheet.EyeColor, BookingSheet.ScarsMarksTattoos, " & _
    "FROM BookingSheet"
    strWhere = "WHERE "
    strOrder = "ORDER BY BookingSheet.BookingSheetNumber;"
    
    'Set the WHERE clause for the Listbox RowSource if information has been entered into a field on the form
    If Not IsNull(Me.txtFirst) Then '<--If the textbox txtFirst contains no data THEN do nothing
        strWhere = strWhere & " (BookingSheet.First) Like '*" & Me.txtFirst & "*'  AND" '<--otherwise, apply the LIKE statment to the QueryDef
    End If
    
    If Not IsNull(Me.txtLast) Then
        strWhere = strWhere & " (BookingSheet.Last) Like '*" & Me.txtLast & "*'  AND"
    End If
    
    If Not IsNull(Me.txtMiddle) Then
        strWhere = strWhere & " (BookingSheet.Middle) Like '*" & Me.txtMiddle & "*'  AND"
    End If
    
    If Not IsNull(Me.txtRace) Then
        strWhere = strWhere & " (BookingSheet.Race) Like '*" & Me.txtRace & "*'  AND"
    End If
    
    If Not IsNull(Me.cmbSex) Then
        strWhere = strWhere & " (BookingSheet.Sex) Like '*" & Me.cmbSex & "*'  AND"
    End If
    
    If Not IsNull(Me.txtHeight) Then
        strWhere = strWhere & " (BookingSheet.Height) Like '*" & Me.txtHeight & "*'  AND"
    End If
    
    If Not IsNull(Me.cmbEyeColor) Then
        strWhere = strWhere & " (BookingSheet.EyeColor) Like '*" & Me.cmbEyeColor & "*'  AND"
    End If
    
    If Not IsNull(Me.cmbHair) Then
        strWhere = strWhere & " (BookingSheet.HairColor) Like '*" & Me.cmbHair & "*'  AND"
    End If
    
    If Not IsNull(Me.smt) Then
        strWhere = strWhere & " (BookingSheet.ScarsMarksTattoos) Like '*" & Me.smt & "*'  AND"
    End If
    
    If Not IsNull(Me.txtmin1) Then
        strWhere = strWhere & " (Year(BookingSheet.DOB)) Between " & Me.txtmin1 & " And " & Me.txtmax5 & " AND"
    End If
    
    'Remove the last AND from the SQL statment
    strWhere = Mid(strWhere, 1, Len(strWhere) - 5)
    
    Me.lstCustInfo.RowSource = strSQL & " " & strWhere & " " & strOrder

End Sub

By using the controls' tag properties that code could be cut down considerably into a loop that builds the same SQL statement. I won't, however, over-complicate things for you and leave you with what you have...fixed. :cool:
 
I know you've given me an inch, and I've taken many miles. I hate to even say this, but the search doesn't display anything now.

I cut and pasted your code for the button. I guess I'm not doing something right. Any ideas? I know you can't make it much easier than that.
 
Send me your email address in a PM and I'll send you what I've changed.
 
You could probably hide those textboxes with the years too as the user shouldn't really need to see them if, indeed, they are really necessary as the code only bothers with the -5 year and the +5 year.
 
Works Great.

I'm going to push my luck.

How do I get a popup box to display if no search information is entered? Right now it starts prompting for BookingSheetNumber.
 
In the button's click event put these line before the rest of the code:

Code: 
Dim strSource As String
strSource = Me.lstCustInfo.RowSource

and these lines at the end before the End Sub statement:

Code: 
    If Me.lstCustInfo.ListCount = 0 Then
        MsgBox "No records found.", vbExclamation
        Me.lstCustInfo.RowSource = strSource
    End If
 
Private Sub cmdSearch_Click()
'Set the Dimensions of the Module
Dim strSQL As String, strOrder As String, strWhere As String
Dim ctl As Control, boo As Boolean

For Each ctl In Me.Controls
If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then
If Not IsNull(ctl) Then
boo = True
Exit For
End If
End If
Next

If boo = False Then
MsgBox "No criteria entered.", vbExclamation
Me.lstCustInfo.RowSource = strSource
Exit Sub
End If

'Constant Select Racement for the RowSource
strSQL = "SELECT BookingSheet.BookingSheetNumber, BookingSheet.First, BookingSheet.Middle, BookingSheet.Last, BookingSheet.Race, BookingSheet.Sex, BookingSheet.DOB, BookingSheet.Height, BookingSheet.Weight, BookingSheet.HairColor, BookingSheet.EyeColor, BookingSheet.ScarsMarksTattoos " & _
"FROM BookingSheet"
strWhere = "WHERE "
strOrder = "ORDER BY BookingSheet.BookingSheetNumber;"

'Set the WHERE clause for the Listbox RowSource if information has been entered into a field on the form
If Not IsNull(Me.txtFirst) Then '<--If the textbox txtFirst contains no data THEN do nothing
strWhere = strWhere & " (BookingSheet.First) Like '*" & Me.txtFirst & "*' AND" '<--otherwise, apply the LIKE statment to the QueryDef
End If

If Not IsNull(Me.txtLast) Then
strWhere = strWhere & " (BookingSheet.Last) Like '*" & Me.txtLast & "*' AND"
End If

If Not IsNull(Me.txtMiddle) Then
strWhere = strWhere & " (BookingSheet.Middle) Like '*" & Me.txtMiddle & "*' AND"
End If

If Not IsNull(Me.txtRace) Then
strWhere = strWhere & " (BookingSheet.Race) Like '*" & Me.txtRace & "*' AND"
End If

If Not IsNull(Me.cmbSex) Then
strWhere = strWhere & " (BookingSheet.Sex) Like '*" & Me.cmbSex & "*' AND"
End If

If Not IsNull(Me.txtHeight) Then
strWhere = strWhere & " (BookingSheet.Height) Like '*" & Me.txtHeight & "*' AND"
End If

If Not IsNull(Me.cmbEyeColor) Then
strWhere = strWhere & " (BookingSheet.EyeColor) Like '*" & Me.cmbEyeColor & "*' AND"
End If

If Not IsNull(Me.cmbHair) Then
strWhere = strWhere & " (BookingSheet.HairColor) Like '*" & Me.cmbHair & "*' AND"
End If

If Not IsNull(Me.smt) Then
strWhere = strWhere & " (BookingSheet.ScarsMarksTattoos) Like '*" & Me.smt & "*' AND"
End If

If Not IsNull(Me.txtmin1) Then
strWhere = strWhere & " (Year(BookingSheet.DOB)) Between " & Me.txtmin1 & " And " & Me.txtmax5 & " AND"
End If

'Remove the last AND from the SQL statment
strWhere = Mid(strWhere, 1, Len(strWhere) - 5)

Me.lstCustInfo.RowSource = strSQL & " " & strWhere & " " & strOrder
If Me.lstCustInfo.ListCount = 0 Then
MsgBox "No records found.", vbExclamation
Me.lstCustInfo.RowSource = strSource
End If

End Sub
 
I can't see anything wrong with the line in question. Be patient; I'll check it later when I get home as its sitting on my drive...and working.
 
If there's one thing I've learned from all this is to be patient. I have a whole new respect for programers.
 
I don't see any difference whatsoever.

Import the form in the demo I sent back to you into your database, replacing the form you currently have.
 
Phil,

I don't know which thread, or which version of the database
to use. The rest of the code for the Clear button is to requery
the listbox after you set its rowsource to "".

Wayne
 
Easiest way to reset the RowSource of a listbox or combo is to store it in a form level string.

i.e.

Code: 
Option Explicit
Option Compare Database
Dim strStore As String

In your form's load event, store the RoSource into the string:

Code: 
Private Sub Fom_Load()
    strStore = Me.MyListBox.RowSource
End Sub

And, on the click of your Clear criteria button:

Code: 
Private Sub cmdClear_Click()
    Dim ctl As Control
    For Each ctl In Me.Controls
        If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then
            ctl = Null
        End If
    Next

    Me.MyListbox.RowSource = strStore
End Sub
 
You must log in or register to reply here.

Similar threads

J
Debugger complains about [apparently] non-existant characters
Replies
9
Views
932
The_Doc_Man
The_Doc_Man
mloucel
Solved Continuous Form and Color Code
Replies
6
Views
390
mloucel
mloucel
E
Solved Select Last Record
Replies
10
Views
1,196
Emma35
E
W
How to Populate a Control in Code and Make it Behave As Though Populated in the GUI
Replies
10
Views
509
arnelgp
arnelgp
T
Solved It takes too long to download data from server
Replies
16
Views
1,403
GPGeorge
GPGeorge

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom