I am trying to search a field called "Model" in a table called "ItemSpecs" but I cannot for the life of me figure it out and I have yet to be able to find any examples on google. In addition to searching the field I am trying to add different search methods (e.g. "Contains","Doesn't contain","Begins with", and "Ends with").
What I have so far
So far I the following but all it does is test which drop down item is selected (which works!).
What I still need
From what I have read I will need to query the table and put it into a vbRecordSet and then search that to get what I want? Which i think the skeleton code below will enable me to do that once I can figure out how to get the query results into the record set and then figure out how to query it.
Notes:
Thanks for the help! Imma keep working this damn thing but if someone can figure it out before me it would be great.
Private Sub Button_Search_Click()
If Len(Me.Search_Text.Value & vbNullString) = 0 Then
MsgBox "No Value"
Else
If Me.Search_Preferance.Value = "Starts with" Then
MsgBox "Starts with"
ElseIf Me.Search_Preferance.Value = "Ends with" Then
MsgBox "Ends with"
ElseIf Me.Search_Preferance.Value = "Contains" Then
MsgBox "Contains"
ElseIf Me.Search_Preferance.Value = "Doesn't contain" Then
MsgBox "Doesn't contain"
Else
MsgBox "Invalid Seach Preference Selected."
End If
End If
I'll assume that you are doing this on a form where the RecordSource is set to "ItemSpecs" (or a select query based off of that table where one of the included columns is "Model"):
Private Sub Button_Search_Click()
If Len(Me.Search_Text.Value & vbNullString) = 0 Then
Me.FilterOn = False
Me.Filter = vbNullString
Else
Dim Txt As String
Txt = Me.Search_Text.Value
Select Case Me.Search_Preferance.Value
Case "Starts with": Me.Filter = "Model Like """ & Txt & "*"""
Case "Ends with": Me.Filter = "Model Like ""*" & Txt & """"
Case "Contains": Me.Filter = "Model Like ""*" & Txt & "*"""
Case "Doesn't contain": Me.Filter = "Model Not Like ""*" & Txt & "*"""
Case Else
MsgBox "Invalid Seach Preference Selected."
End Select
Me.FilterOn = True
End If
End Sub
Related
I had gotten my question answered by a colleague of mine, but I wanted to re-post here in case anyone else has the issue, and to pose the question, which you'll note at the end. The original post, if interested, is here: Original Post
Many thanks to all in the community here, particularly #Andre for your help!
It was strange, but when I did that, it kept trying to put in all my letters backwards. Example: If I searched "Smith", it would enter it as "htims". I'm sure it had something to do with the on click event, but I had a friend look at it and I think she cracked it! It looks like this (I've added a comment to what the new line(s) of code is/are):
First, the textbox click event whereby when you click the box, it clears the text and resets the search (no need for a reset button)
Private Sub txtSearch_Click()
Me.txtSearch.SetFocus 'new line of code
Me.txtSearch.Text = ""
Me.Requery
With Me.txtSearch
.SetFocus
.SelStart
End With
End Sub
This is the actual search, that will search multiple fields
Private Sub txtSearch_Change()
Dim strFilter As String
Dim sSearch As String
On Error Resume Next
If Me.txtSearch.Text <> "" Then
sSearch = "'*" & Replace(Me.txtSearch.Text, "'", "''") & "*'"
strFilter = "[Last_Name] Like " & sSearch & " OR [First_Name] Like " & sSearch & " OR [SSN] Like " & sSearch
Me.Filter = strFilter
Me.FilterOn = True
Else
Me.Filter = ""
Me.FilterOn = False
End If
If Me.Recordset.RecordCount = 0 Then 'new line of code
Me.Filter = "" 'new line of code
Me.FilterOn = False 'new line of code
Me.txtSearch.SetFocus 'new line of code
Me.txtSearch.Text = "" 'new line of code
Exit Sub 'new line of code
End If 'new line of code
With Me.txtSearch
.SetFocus
.SelStart = Len(Me.txtSearch.Text)
End With
End Sub
This seems to be working great. And while I'm considering this issue complete, I do have a question, if you could help me identify, why were the letters going in backwards when I replaced the .Text with a .Value?
Thank you all very much for your help!
First you need to change the Click event to Enter and scrap the .SetFocus since the control will have the focus:
Private Sub txtSearch_Enter()
With Me
.txtSearch.Value = ""
.Requery
End With
End Sub
Regarding the difference between .Text and .Value:
The .Text property updates with every keystroke you make where the .Value property gets updated only when the control loses focus.
On the Change event, you should check two things: a) the textbox has a value (.Text) to apply the filter and b) the recordcount to clear the filter if no records returned.
Private Sub txtSearch_Change()
Dim strFilter As String, sSearch As String
On Error Resume Next
With me
If .txtSearch.Text <> "" Then
sSearch = "'*" & Replace(.txtSearch.Text, "'", "''") & "*'"
strFilter = "[Last_Name] Like " & sSearch & " OR [First_Name] Like " & sSearch & " OR [SSN] Like " & sSearch
.Filter = strFilter
.FilterOn = True
End If
If .Recordset.RecordCount = 0 Then
.Filter = ""
.FilterOn = False
End If
End With
End Sub
The reason for the backward letters, was the .SelStart property where the cursor was jumping at the beginning every time you typed a letter, thus giving you the impression it was flipping the word backwards.
I have a VB6 Project I am creating and i have a method that searches and edits students from an access database. i need to code the program so it can select the student that was searched and modify it. I saw this webpage but it does not select the student, the user has to select it before making edits, https://support.microsoft.com/en-us/kb/195472 . How do i program it so it can select that particular row so the user can edit.
Code using the website:
Option Explicit
Dim connSearch As New ADODB.Connection
Dim rec As New ADODB.Recordset
Private Sub cmdSearch_Click()
connSearch.Close
connSearch.Open connstr
rec.CursorLocation = adUseClient
If cmbSearch.Text = "Last Name" Then
rec.Open "Select * From Table1 where [Last Name] like '" & txtSearch.Text & "'", connSearch, adOpenDynamic, adLockOptimistic
frmStudents.cmdShowall.Enabled = True
If rec.EOF Then
MsgBox "No Student Found.", vbInformation, "Error"
Else
Set frmStudents.StudentTable.DataSource = rec
MsgBox "Student found Successfully", vbInformation, "Success"
' Remove previously saved bookmark from collection
If (frmStudents.StudentTable.SelBookmarks.Count <> 0) Then
frmStudents.StudentTable.SelBookmarks.Remove 0
End If
' Append your bookmark to the collection of selected rows
frmStudents.StudentTable.SelBookmarks.Add rec.Bookmark
frmSearch.Hide
End If
End If
End Sub
Thanks for the help. :)
EDIT: Move code from comments to here
Private Sub Form_Load()
connSearch.Open connstr 'open the connection
frmStudents.Adodc1.ConnectionString = conn.connstr
Set frmStudents.StudentTable.DataSource = frmStudents.Adodc1
End Sub
You must be using a recordset to fill the frmStudents.Adodc1 Datasource but for some reason you don't want to show that code.
Then in the code you try you're opening a new recordset to search for the student and assign a bookmark. That will not work.
If you want to show all the students - like the example shows - you need to leave the data source alone and do the find on the same recordset used by your datagrid.
It's hard for me to guess what that is since you're not showing me the Form's code - I assume the recordset is global withing the form's module - but maybe not?
Without that information I can guess at something, hoping maybe the translation will work.
Replace this
rec.Open "Select * From Table1 where [Last Name] like '" & txtSearch.Text & "'", connSearch, adOpenDynamic, adLockOptimistic
frmStudents.cmdShowall.Enabled = True
If rec.EOF Then
MsgBox "No Student Found.", vbInformation, "Error"
Else
Set frmStudents.StudentTable.DataSource = rec
MsgBox "Student found Successfully", vbInformation, "Success"
' Remove previously saved bookmark from collection
If (frmStudents.StudentTable.SelBookmarks.Count <> 0) Then
frmStudents.StudentTable.SelBookmarks.Remove 0
End If
' Append your bookmark to the collection of selected rows
frmStudents.StudentTable.SelBookmarks.Add rec.Bookmark
frmSearch.Hide
With this
Dim varBookmark as Variant
With frmStudents.StudentTable
varBookMark = .Bookmark
' Remove previously saved bookmark from collection
If (.SelBookmarks.Count <> 0) Then
.SelBookmarks.Remove 0
End If
.Recordset.Find "[Last Name] like '" & txtSearch.Text & "'"
' If Find method fails, notify user
' If the search fails, the Recordset will point to either EOF or BOF.
If .Recordset.EOF or .Recordset.BOF Then
Msgbox "No Student Found"
' Reset back to last selection
.Recordset.Bookmark = varBookmark
Else
Msgbox "Student Found"
.SelBookmarks.Add .Recordset.Bookmark
Endif
End With
Ideally you'd just use the recordset variable that you assigned to frmStudents.Adodc1 instead of frmStudents.Adodc1.Recordset, but you haven't shared that with me so maybe this will work for you
Filters in Access seem to be 'sticky' - when you set one with VBA you can remove it but you can't set a different one.
I have a Access database for tracking student scores. It has tables subjects, teachers, students, tests and test_results. Each results record refers to a student and a test.
I have a form displaying tests with a subform displaying results. I want to search for tests using various criteria so I added some unbound fields to the (outer) form header and labelled them 'name', 'subject', 'start date', 'end date' and 'teacher'. I added a 'filter' button and a 'reset' button. Each search field is optional so any combination can be used: any left blank will be ignored.
This is the code for the filter button:
Me.Filter =
"([Forms]![testWithResults]![Text102] IS NULL OR test_name Like '*' & [Forms]![testWithResults]![Text102] & '*')
AND ([Forms]![testWithResults]![Combo89] IS NULL OR teacher = [Forms]![testWithResults]![Combo89])
AND ([Forms]![testWithResults]![Combo52] IS NULL OR subject = [Forms]![testWithResults]![Combo52])
AND ([Forms]![testWithResults]![Text83] IS NULL OR [Forms]![testWithResults]![Text85] IS NULL OR test_date BETWEEN [Forms]![testWithResults]![Text83] AND [Forms]![testWithResults]![Text85])"
Me.FilterOn = True
This is the code for the reset button:
Me.FilterOn = False
Me.Combo89 = Me.Combo89.DefaultValue
Me.Combo52 = Me.Combo52.DefaultValue
Me.Text83 = Me.Text83.DefaultValue
Me.Text85 = Me.Text85.DefaultValue
Me.Text102 = Me.Text102.DefaultValue
When I first load the form, the first time I search it all works perfectly. The filter button works just as expected and the reset button empties all fields and displays all records. But when I try to search again with new criteria I just get my old results again. To make it work I have to close and reopen the form.
When I replaced Me.Filter with DoCmd.ApplyFilter it still worked perfectly the first time but the second time I would get an error 'the expression is too complex to be evaluated'.
Since Access complains the Filter string is too complex, simplify it.
You want to base a Filter condition on a text box. At the time you create the Filter string, your code can check whether that text box is Null. If it is not Null, add a condition based on the text box's value. If it is Null, the Filter can simply ignore that text box.
Dim strFilter As String
With [Forms]![testWithResults]
If Not IsNull(![Text102]) Then
strFilter = strFilter & " AND test_name Like '*" & ![Text102] & "*'"
End If
If Not IsNull(![Combo89]) Then
strFilter = strFilter & " AND teacher = " & ![Combo89]
End If
If Not IsNull(![Combo52]) Then
strFilter = strFilter & " AND subject = " & ![Combo52]
End If
If Not (IsNull(![Text83]) Or IsNull(![Text85])) Then
strFilter = strFilter & " AND test_date BETWEEN " & Format(![Text83], "\#yyyy-m-d\#") _
& " AND " & Format(![Text85], "\#yyyy-m-d\#")
End If
End With
If Len(strFilter) > 0 Then
' use Mid() to discard leading " AND "
Debug.Print Mid(strFilter, 6) '<- view this in Immediate window; Ctrl+g will take you there
Me.Filter = Mid(strFilter, 6)
Me.FilterOn = True
Else
MsgBox "no conditions for Filter"
End If
This question was asked in the topic with a similar name earlier, but the answer provided didn't really indicate HOW those events would help determine whether somebody was typing in the combo box or selecting an item in the list. I think that it really answered the other question about how to determine when somebody was done typing, but without seeing the event handlers, I can't be sure.
Unfortunately, I'm new here and don't have enough reputation to post a comment asking for clarification, so I have to start a new question. Here's what I'm trying to do:
I have a form with a combo box in the Header and, as I type in the combo box, I want the characters that I've typed to be used as a filter on the Details part of the form. Both the combo box control source and the form's record source use the same query string.
I've tried numerous iterations of the code below, but I can't get it to work correctly.
Private Sub cmbAppName_Change()
Dim strApp As String
Dim nSelStart As Integer
Dim nSelLen As Integer
Dim nSelected As Integer
Dim strMsg As String
On Error GoTo ERR_SUB
strMsg = ""
Me.cmbAppName.SetFocus
' Get current selection details
nSelStart = Me.cmbAppName.SelStart
nSelLen = Me.cmbAppName.SelLength
nSelected = Me.cmbAppName.ListIndex
Me.cmbAppName.SetFocus
strApp = Nz(Me.cmbAppName.Text, "")
Debug.Print "Index = " & nSelected & "; SelStart = " & nSelStart & "; SelLen = " & nSelLen
If nSelected = -1 Then
Debug.Print "Change by typing: " & strApp
Else
Debug.Print "Change by list selection: " & strApp
End If
' Get the part of the text that the user has typed
If nSelStart > 0 Then
strApp = Left(strApp, nSelStart)
Debug.Print "App piece = '" & strApp & "'"
End If
' If there is text, set a filter (MatchAppName = InStr(strApp, datbase_column_value)
If strApp <> "" Then
Me.Filter = "MatchAppName('" & strApp & "', " & DCApplications_Application_Col & ") > 0"
Me.FilterOn = True
' Me.txtApplication.SetFocus
' Call DoCmd.FindRecord(strApp, acStart, False, acSearchAll, False, acCurrent, True)
' Me.cmbAppName.SetFocus
Else
Me.Filter = ""
Me.FilterOn = False
End If
EXIT_SUB:
' Restore the selection in the combo box's text box
Me.cmbAppName.SetFocus
Me.cmbAppName.SelStart = nSelStart
Me.cmbAppName.SelLength = nSelLen
Exit Sub
ERR_SUB:
If ERR.Number = 2185 Then
strApp = Nz(Me.cmbAppName.Value, "")
Me.cmbAppName.SetFocus
Debug.Print "Using " & strApp
Resume Next
End If
Me.Filter = ""
Me.FilterOn = False
Debug.Print ErrorMessage(ERR.Description, "cmbAppName_Change", ERR.Number, "Value = '" & Me.cmbAppName.Value & "'", False)
Resume EXIT_SUB
End Sub ' cmbAppName_Change
As you can see from the error handling code, I'd often get an error 2185 telling me that my control didn't have focus when using the Text property despite having a SetFocus call right before it.
If somebody selects from the list (either by clicking or moving the selection), I'd like to go to that record, but I at least need the above piece working first.
After searching the Web, I found out that a Details section with zero records causes the 2185 error. Apparently, filtering like that causes problems when all records are filtered out.
The solutions on the Web said that you can set the Allow Additions property of the form to True, but that always displays one row in the Details section. This can be especially confusing if the rows in the Details section contain controls, which will be displayed in the "addition" row. Also, I would still get an error typing additional characters after the one that caused the Details section to have zero records.
Eventually, I replaced the combo box with a simple text control to filter the Details section. When the Details section has rows, I turn Allow Additions off and make the controls visible; when it doesn't have rows, I turn Allow Additions on and hide the controls.
Here's the code that I used:
Private Sub txtApplicationFilter_Change()
Dim strApp As String
Dim nSelStart As Integer
Dim nSelLen As Integer
Dim strFilter As String
Dim strQuery As String
Dim strWhere As String
Dim nRecs As Integer
On Error GoTo ERR_SUB
' Save text selection
nSelStart = Me.txtApplicationFilter.SelStart
nSelLen = Me.txtApplicationFilter.SelLength
' Get application name typed and selection information
strApp = Nz(Me.txtApplicationFilter.Text, "")
strFilter = "[" & DCApplications_Application_Col & "] LIKE '*" & EscapeQuotes(strApp) & "*'"
nRecs = DCount("[" & DCApplications_Application_Col & "]", LocalTableName(DCApplications_Tab), strFilter)
' Kludge code to prevent various errors (like 2185) when no records are returned in the form
Call UpdateList(nRecs)
' Update the record source to reflect the filtered list of apps
strWhere = " WHERE APPS." & strFilter
strQuery = strSelect & strFrom & strWhere & strOrderBy
Me.RecordSource = strQuery
' 20200423 SHM: Restore or update filter to avoid issues with Delete and Backspace and applications with spaces in their names
Me.txtApplicationFilter.SetFocus
Me.txtApplicationFilter = strApp
Me.txtApplicationFilter.SelStart = nSelStart
Me.txtApplicationFilter.SelLength = nSelLen
EXIT_SUB:
Me.btnAddNew.enabled = (Nz(Me.txtApplicationFilter, "") <> "")
Exit Sub
ERR_SUB:
' NOTE: ErrorMessage is a helper function that basically displays a form displaying the error
Call ErrorMessage(ERR.Description, "txtApplicationFilter_Change", ERR.Number, "Filter = " & strApp & " Records = " & nRecs)
Resume EXIT_SUB
Resume Next
End Sub ' txtApplicationFilter_Change
Private Sub UpdateList(nRecs As Integer)
Dim bShowControls As Boolean
On Error GoTo ERR_SUB
bShowControls = (nRecs > 0)
' Kludge code to turn off checkbox control source
If bShowControls Then
strSelect = strSelectStart & ", (" & strAppUser & ") AS " & strCtrlSource
Me.chkTestedByMe.ControlSource = strCtrlSource
Else
strSelect = strSelectStart
Me.chkTestedByMe.ControlSource = ""
End If
' Kludge code to prevent various errors (like 2185) when no records are returned in the form
' Turning on AllowAdditions prevents errors when no records are returned.
' However, that puts an empty row in the form, but the controls are showing, so we have to hide them to prevent confusing the user.
Me.AllowAdditions = Not bShowControls
Me.btnAddExisting.visible = bShowControls
Me.chkTestedByMe.visible = bShowControls
EXIT_SUB:
Exit Sub
ERR_SUB:
Call ErrorMessage(ERR.Description, "UpdateList", ERR.Number, " Records = " & nRecs)
Resume EXIT_SUB
Resume Next
End Sub ' UpdateList
I would use a work around to settle this issue
A simple code bellow demonstrate the work around using Tag property of Combo Box and keypress event along with change event, I hope it can be applied in your code
Private Sub Combo2_Change()
If Combo2.Tag = 1 Then
Text4 = "change - from key"
Else
Text4 = "change - from select"
End If
Combo2.Tag = 0
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
Combo2.Tag = 1
End Sub
Don't forget to set Tag property of Combo Box to 0 on design view to avoid error at comparing empty Tag with number
I'm using a code i found online to fill in form fields in a Word document. When i use it on an empty document and add to it a form field, it works. However, when i use it on the form i'm trying to fill nothing happens when i execute the code. I checked the name of the fields in Word and they match the code, i don't know what's wrong.
I also checked the data type in Access and it's not the problem, i don't have access to the code right now but does anyone have any idea of what's causing this?
Edit: Here is a similar code, i don't have access to the exact same one:
Dim appWord As Word.Application
Dim doc As Word.Document
'Avoid error 429, when Word isn't open.
Err.Clear
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set appWord = New Word.Application
End If
Set doc = appWord.Documents.Open("C:\Users\" & Environ$("Username") & "\Desktop\Form.doc", , True)
With doc
.FormFields("TextEn").Result = DLookup("[End date]", "[Table1]", "[Table1]![ID Number] =" & [ID2])
.FormFields("TextSt").Result = DLookup("[Starting date]", "[Table1]", "[Table1]![ID Number] =" & [ID2])
.Visible = True
.Activate
End With
Set doc = Nothing
Set appWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
You could try to validate that your dlookup is returning a value with the following:
If DCount("[End date]", "[Table1]", "[Table1]![ID Number] =" & [ID2]) > 0 then
.FormFields("TextEn").Result = DLookup("[End date]", "[Table1]", "[Table1]![ID Number] =" & [ID2])
End If
You would have to do this for each lookup before trying to set your fields.