Help coding a VBA script for a search feature

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I'm trying to create a VBA script that will allow a search feature in a
dialog box. Basically I want to be able to search for any field and then
apply a filter so that only the records that contain the inputted text.

Example: I want to search for a record that has "dog" somewhere in the
record, and every record that has "dog" in it would be visable.

I know this is probably hard to do, but I am familiar with programming just
not the VBA scripting.

Also, want this to be able to work in Forms, Reports, and Pages.
 
Are you saying you want to select a field in the table and return all records
with the search value in that field or are you saying you want to find that
value in any field in the records? And, do you want an exact match, or a
"contains" match?
 
I'm saying i want to find a value in any field and return any records that
contain that value in any field. Looking for a contains match
 
First, be aware that if your table is large, this could take a long time.
You will need to create a table with the same structure as the table you
want to search so you will have a place to store the matching records. The
code will read through the records and for each record will compare each
field to the search value. If it finds a match, it will write the record to
the other table.

Sub FindFieldValue(varFindValue as Variant)
Dim dbf As Database
Dim rstFind As Recordset
Dim rstKeep as Recordset
Dim fld As Field
Dim lngFldCount As Long
Dim lngFldLoop As Long

Set dbf = CurrentDb

'Delete the data from the last search
dbf.Execute "DELETE * FROM tblKeep;", dbFailOnError

'Open the record sets

Set rstFind = dbf.OpenRecordset("tblSearch")
Set rstKeep = dbf.OpenRecordset("tblKeep")

If rstFind.Recordcount = 0 Then
MsgBox "No Records to Process"
Exit Sub
End If

rstFind.MoveLast
rstFind.MoveFirst

lngFldCount = rstFind.Fields.Count - 1

Do While Not rstFind.EOF
For Each fld = rstFind.Fields
If fld = varFindValue Then
rstKeep.Addnew
For lngFldLoop = 0 to lngFldCount
rstKeep.Fields(lngFldLoop) = rstFind.Fields(lngFldLoop)
Next lngFldLoop
rstKeep.Update
Exit For
End If
Next fld
rstFind.MoveNext
Loop

rstFind.Close
rstKeep.Close
Set rstFind = Nothing
Set rstKeep = Nothing
Set fld = Nothing
Set dbf = Nothing

End Sub

The above code has not been tested.
 
Back
Top