Home > OS >  how to speedup search filter upon change (VBA)
how to speedup search filter upon change (VBA)

Time:04-27

Objective: i want to achieve my search filter without freezing or taking so much time to load once i enter string in my search textbox. this will display all the items with or without movement.

i have 2 database where i pulled out the records.

  • Settings Database (Item Table) - item_id, item_desc, item_details, item_category, item_cost
  • Main Inventory Database (Inventory Table) - item_id, item_movement, item_qty
  • Both database has been encrypted.
  • item_id has been set to indexed (no duplicate)

My Settings db right now has 200 records and my Main Inventory has 2000 records.

Problem: Everytime I filter my data using textbox_change, it keep on freezing and it takes time to filter records.

My Code:

Private Sub txtSearchWindow_Change()

Call OpenDbSettings 'OPEN DATABASE
DbName = DatabaseLoc & "DATABASE\MAIN INVENTORY.accdb"
Call OpenDbInventory(DbName)

MYSQL = "SELECT item_id, item_desc, itm_details, itm_category, item_cost FROM ITEM " & _
"WHERE (item_id LIKE '%" & Replace(.txtSearchWindow.Text, "'", "''") & "%' " & _
"OR item_name LIKE '%" & Replace(.txtSearchWindow.Text, "'", "''") & "%' " & _
"OR item_category LIKE '%" & Replace(.txtSearchWindow.Text, "'", "''") & "%')"
MYSQL = MYSQL & " ORDER BY itm_category, itm_name"

Set rsItem = dbSettings.Execute(MYSQL)

If rsItem.EOF Then
Else
    Do Until rsItem.EOF = True
        Set li = .lvSearchWindow.ListItems.Add(, , rsItem.Fields("item_id"))
            li.SubItems(1) = Replace(rsItem.Fields("item_name"), "''", "'")
            li.SubItems(2) = Replace(rsItem.Fields("item_category"), "''", "'")

            
        MYSQL = "SELECT item_id, SUM(item_qty) AS NewItmQty FROM INVENTORY"
        MYSQL = MYSQL & " WHERE item_id = '" & rsItem.Fields("itm_id") & "'"
        MYSQL = MYSQL & " GROUP BY item_id"
        
        Set rsInventory = dbInventory.Execute(MYSQL)
        
        If rsInventory.EOF Then
            li.SubItems(3) = "0"
        Else
            li.SubItems(3) = FormatNumber(rsInventory.Fields("NewItmQty"), 0, , vbTrue)
        End If
    
        rsInventory.Close
        Set rsInventory = Nothing
        
        li.SubItems(4) = FormatNumber(rsItem.Fields("itm_cost"), 2, , vbTrue)
        li.SubItems(5) = Replace(rsItem.Fields("itm_details"), "''", "'")
    rsItem.MoveNext
Loop
End If

rsItem.Close 'CLOSE RECORDSET
Set rsItem = Nothing

dbInventory.Close 'CLOSE DATABASE
Set dbInventory = Nothing

dbSettings.Close 'CLOSE DATABASE
Set dbSettings = Nothing

End Sub

Question: is there anyway i can speed up my search filter

CodePudding user response:

It's no surprise this is slow - you have a separate database query for each single row of the main recordset result.

To improve this, you need to combine this into a single query that has GROUP BY Item and a left join from ITEM to INVENTORY.

And for this, you need to put both tables into the same database.

Further improvement: don't immediately search on each Change, instead wait a few 100 ms and search after the user has stopped typing. Example in Access VBA: https://stackoverflow.com/a/51608017/3820271

  • Related