VBA Filter by InPutBox Value Error

[Joe Was]

User form shows current record or selected record form ListBox kyed to the column record source field [Word]. A form button runs the code below: Which gets a word or part of a word from a InputBox and displays the first record like it and also makes it the first record in the list box. If it worked right?

This code returns an error "You can't assign a value to this object." somewhere below the InPutBox?

Private Sub AShowBut_Click()
'Show filtered records starting with ? in a form's [LookUpDef_Form] FieldBox's and
'a ListBox containing the table's [LookUpDef_Table] sorted column [Word] records.
Dim strFilter As String

On Error GoTo Err_AShowBut_Click
strFilter = InputBox("Go to your entered ""Word"" below:")
strFilter = strFilter + "*"
'MsgBox strFilter

Me.Filter = "([Word], strFilter, True, vbTextCompare)"
Me.FilterOn = True
Me.Filter = "strFilter"
Me.FilterOn = True

Exit_AShowBut_Click:
Exit Sub

Err_AShowBut_Click:
MsgBox Err.Description
Resume Exit_AShowBut_Click
End Sub

 

[mdmilner]

Think you did fine until here:

Me.Filter = "([Word], strFilter, True, vbTextCompare)" 
Me.FilterOn = True 
Me.Filter = "strFilter" 
Me.FilterOn = True

This line: (Me.Filter = "strFilter" ) would assign the word "strFilter" to the filter, not the variable.

This line: (Me.Filter = "([Word], strFilter, True, vbTextCompare)" ) Well, sure looks like you're trying to use some kind of custom function but, well, I'm just not familiar with one that takes parameters like the above. [Word] looks like you're referencing a table field, while strFilter is of course the above. Could this be syntax from Excel?

Most of my Access Form filters look like (this was to set a filter on a subform) based on the value in a combo box.

Me.sfmTask.Form.Filter = "[task_name]='" & Me.cboSelTask.Value & "'"
Me.sfmTask.Form.FilterOn = True
Me.sfmTask.Form.Visible = True

Two things. Go into a query and look at the 'WHERE' parameter clause in it. Your Filter statement will look just like it without the "WHERE" syntax.

Second, did you notice how I inserted a single quote around the text value to compare a string to a field in a table? That's mandatory syntax.

Me.Requery

Mike

 

[Joe Was]

Thanks, that helped, but it did not update the active record and I never could fix the problem. So, I used a caned "Menu" function which also caused a different problem.

I open the form with the first record from a sorted table, a list box serves as a record selection tool its code is:

Private Sub ListBox_Lookup_AfterUpdate()
' Find the record that matches the control.
Dim rsc As Object

Set rsc = Me.Recordset.Clone
rsc.FindFirst "[Word] = '" & Me![ListBox_Lookup] & "'"
If Not rsc.EOF Then Me.Bookmark = rsc.Bookmark
End Sub

If you click a key from the ListBox the form displays that record. And, my "Find" button also selects the first record that matches the inputed key. Both update the form correctly.

The problem is when the "Find" button updates the form the ListBox is not updated as well?

I would like the ListBox's top row to match the displayed record's key if the form was updated by the "Find" button Code as well. This is my Find code:

Private Sub FindRecord_Button_Click()
On Error GoTo Err_FindRecord_Button_Click

Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
'Me.ListBox_Lookup.ItemsSelected.Item(0) = Me.CurrentRecord
DoCmd.Requery
Me.Repaint
DoCmd.Restore

Exit_FindRecord_Button_Click:
Exit Sub

Err_FindRecord_Button_Click:
MsgBox Err.Description
Resume Exit_FindRecord_Button_Click
End Sub

Every thing I have tried has failed?
Any ideas?

 

[Joe Was]

This event code fixed the above problem:

Private Sub Form_Current()
Dim myWord As Variant

'Select found record in ListBox after "Find."
If upDateList = "T" Then
Me.Word.SetFocus
myWord = Me![Word].Text
Me.ListBox_Lookup.Value = myWord
End If
upDateList = "F"
End Sub

The "T" and "F" are soft switches that test for a "Find" operation so the code only updates the ListBox when needed!

I would like to also have the selection be the top row or second row of the visible items in the list box if anyone knows how?

 

[Joe Was]

This fixed the find problems I had when using the built-in find and replace tool. It uses a custom find utility.

Private Sub FindMyWord_Click()
'Fuzzy search and show sorted records in the form's (LookUpDef_Form) FieldBox's and
'ListBox containing the table's [LookUpDef_Table] sorted column [Word] records based
'upon your entered string in a InPutBox!
On Error GoTo Err_FindMyWord_Click

Dim strMessage As String
Dim strSeek1 As Variant
Dim strSeek2 As String
Dim varBookmark As Variant
Dim rsc As Object

'Build recordset clone of the database table to work with.
Forms!LookUpDef_Form.RecordSource = "LookUpDef_Table"
Set rsc = Me.Recordset.Clone

strMessage = "Go to your: ""Word"" or the ""First-part"" of" & _
" that word, in the ""Glossary.""" & Chr(13) & Chr(13) & "Enter your string below:"

'Get string to fuzzy search with.
strSeek1 = InputBox(strMessage, "Search the Glossary!")

'Test for InPutBox = Cancel Button.
If StrPtr(strSeek1) = 0 Then
GoTo myEnd
End If

'Test for InPutBox = Blank.
If strSeek1 = "" Then
MsgBox "No ""String"" to search for was entered!" & Chr(13) & Chr(13) & _
"No Action Taken!"
GoTo myEnd
End If

'Add fuzzy wildcard ending to string.
strSeek2 = strSeek1 + "*"

'Find string in records.
DoCmd.FindRecord strSeek2, acStart, , acSearchAll, acCurrent
DoCmd.GoToControl "ListBox_Lookup"
rsc.FindFirst "[Word] = '" & Me![ListBox_Lookup] & "'"

'Test for no-part of string in table.
rsc.MovePrevious
If rsc.BOF Then
MsgBox "No ""Word"" or ""First-part-of-a-word"" is close to matching your" & _
Chr(13) & "String: " & strSeek1 & "." & Chr(13) & Chr(13) & "No Other Action Taken!"
rsc.MoveFirst
GoTo myEnd
End If
rsc.MoveNext

'Test for not an exact match with string.
If Not rsc.EOF And CurrentRecord <> acFirst Then
Me.Bookmark = rsc.Bookmark
MsgBox "Your ""String: " & strSeek1 & " was not found!" & Chr(13) & Chr(13) & _
"Attempting to find something close!"
End If

'No action or end of action tag.
myEnd:
Exit_FindMyWord_Click:
Exit Sub

'System Error responce.
Err_FindMyWord_Click:
MsgBox Err.Description
Resume Exit_FindMyWord_Click
End Sub