Search code examples
vbams-access

Search box not allowing me to type a space between words


I have a textbox on a form that is filtering my data by the company name. The reason for the close and open code in the error handling is because I couldn't find a way to easily fix it throwing an error when a combination of characters not present would be entered. This way it just closes and reopens it and basically resets it. I am still fairly new to this development and all I know is taught to myself through google and forums like this so forgive my lack of understanding when things should make sense to someone else able to do these types of functions.

Upon typing part of a company name and pressing space to type in a second word it essentially removes the space and puts the cursor back to the last letter typed.

This is the code for the textbox.

Reminder that I find solutions to the functions I need and adapt the code as best I can to suit my needs. I don't pretend to fully comprehend what I use yet and I'm still learning.

Private Sub txtSearch_KeyUp(KeyCode As Integer, Shift As Integer)

On Error GoTo errHandler

    Dim filterText As String
    
    'Apply or update filter based on user input.
    If Len(txtSearch.Text) > 0 Then
        filterText = txtSearch.Text
        Me.Form.Filter = "[tblSuppliers]![SupplierName] like '*" & filterText & "*'"
        Me.FilterOn = True
        
        'Retain filter text in search box after refresh
        txtSearch.Text = filterText
        txtSearch.SelStart = Len(txtSearch.Text)
    Else
        'Remove filter
        Me.Filter = ""
        Me.FilterOn = False
        txtSearch.SetFocus
    End If
    
Exit Sub

errHandler:

MsgBox Err.Number & " - " & Err.Description, vbInformation + vbOKOnly, "Information"

    DoCmd.Close acForm, "frmCosteeDetails", acSaveNo
    DoCmd.OpenForm "frmCosteeDetails"

End Sub

In my search to try and find a way to fix the removal of spaces I found this function that someone listed but wasn't sure how to integrate it into my code.

Public Function FindWord(varFindIn As Variant, varWord As Variant) As Boolean

   Const PUNCLIST = """' .,?!:;(){}[]/"
   Dim intPos As Integer

   FindWord = False

   If Not IsNull(varFindIn) And Not IsNull(varWord) Then
       intPos = InStr(varFindIn, varWord)

       ' loop until no instances of sought substring found
       Do While intPos > 0
           ' is it at start of string
           If intPos = 1 Then
               ' is it whole string?
               If Len(varFindIn) = Len(varWord) Then
                   FindWord = True
                   Exit Function
               ' is it followed by a space or punctuation mark?
               ElseIf InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
                   FindWord = True
                   Exit Function
               End If
           Else
               ' is it precedeed by a space or punctuation mark?
               If InStr(PUNCLIST, Mid(varFindIn, intPos - 1, 1)) > 0 Then
                   ' is it at end of string or followed by a space or punctuation mark?
                   If InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
                       FindWord = True
                       Exit Function
                   End If
               End If
           End If

           ' remove characters up to end of first instance
           ' of sought substring before looping
           varFindIn = Mid(varFindIn, intPos + 1)
           intPos = InStr(varFindIn, varWord)
       Loop
   End If

End Function

Edit - Code for Current Solution

Private Sub txtSearch_Change()

On Error GoTo errHandler
    
    'clear filter
    If Len(txtSearch.Text) = 0 Then
        FilterOn = False
        Filter = vbNullString
        Exit Sub
    End If
    
    'apply filter
    Filter = "[SupplierName] like '*" & txtSearch.Text & "*'"
    FilterOn = True
 
Leave:
    Exit Sub

errHandler:
    MsgBox Err.Number & " - " & Err.Description, vbInformation + vbOKOnly, "Information"
    Resume Leave
    
    'DoCmd.Close acForm, "frmCosteeDetails", acSaveNo
    'DoCmd.OpenForm "frmCosteeDetails"

End Sub

Solution

  • Rather than using a text box to constantly update as typed just change it to a search button that when clicked searches based on the value in the search box. All you have to do is then update the search criteria each time and click search. a bit slower but functions mostly the same.

    Private Sub cmdSearch_Click()
    
        Dim strWhere As String
        
        strWhere = "[tblSuppliers]![SupplierName] Like '*" & Me.txtSearch & "*'"
        
        'Apply Filter
        Me.Filter = strWhere
        Me.FilterOn = True
    
    End Sub