Results 1 to 5 of 5
  1. #1
    jjsande1492 is offline Advanced Beginner
    Windows 7 64bit Access 2016
    Join Date
    May 2018
    Posts
    38

    Speeding up a query to a linked table from multiselect listboxes

    Hi, everyone.

    I have a form that lets users search for vehicles. The form queries a linked table in another database that I cannot control.

    The user can interact with six multiselect listboxes. These list boxes correlate to vehicle manufacturer, model, series, engine, transmission, and manufacture date. I have the form set up so that after each change in any of the listboxes, it triggers an event to requery everything in order to filter the results based on the user's selections. In other words, when they select a manufacturer and model, there might be 30 engines shown that relate to that selection, but when they select a series (or an additional model), the number of engines shown will shrink to reflect the changes. I want to keep this setup.

    This is relatively speedy when connected to a wired network connection. However, when connected to a wireless network, you need to VPN into the network and the query slows dramatically. Usually from less than a second to at least 30 seconds. I'm not asking anyone to diagnose our network performance issues. I'm just looking for a faster method of querying the linked table.

    A summary of the code below is:
    1. There are six blocks of code to detect if the user has selected anything in each of the listboxes and creates a string to use in the SQL.
    2. Five queries are performed (manufacturer is excluded because I don't want this listbox to be filtered) for each listbox and the results are put in the rowsource.
    3. I re-select the user's selections since changing the rowsource has removed the selections.

    The hangup definitely seems to be running the queries rather than the rest of the code. So, I was hoping there was a more efficient way of doing this.

    Code:
    Private Sub ListOptionUpdate()
    
    Dim SelectedItem As Variant                                                                             'Object for holding listbox contents
    Dim SelectedMakes As String                                                                             'All makes the user has selected
    Dim SelectedMakesArray() As String                                                                      'Array of selected makes
    Dim SelectedModels As String                                                                            'All models the user has selected
    Dim SelectedModelsArray() As String                                                                     'Array of selected models
    Dim SelectedSeries As String                                                                            'All series the user has selected
    Dim SelectedSeriesArray() As String                                                                     'Array of selected series
    Dim SelectedEngines As String                                                                           'All engines the user has selected
    Dim SelectedEnginesArray() As String                                                                    'Array of selected engines
    Dim SelectedTransmissions As String                                                                     'All transmissions the user has selected
    Dim SelectedTransmissionsArray() As String                                                              'Array of selected transmissions
    Dim SelectedManufactureDates As String                                                                  'All manufacture dates the user has selected
    Dim SelectedManufactureDatesArray() As String                                                           'Array of selected manufacture dates
    Dim x As Long                                                                                           'Used in looping
    Dim y As Long                                                                                           'Used in looping
    
    
    'Check to see if any makes were selected
    If Me.lst_Make.ItemsSelected.Count > 0 Then
     
     x = 1                                                                                                  'Start the counter
     
     'Loop through each item selected and modify the string the select statement will use in its search
     For Each SelectedItem In Me.lst_Make.ItemsSelected
      SelectedMakes = SelectedMakes & "'" & Me.lst_Make.ItemData(SelectedItem) & "',"                       'Add the item selected to the string to be searched for
     
      ReDim Preserve SelectedMakesArray(1 To x)                                                             'Increase the size of the array
      SelectedMakesArray(x) = Me.lst_Make.ItemData(SelectedItem)                                            'Assign the next array value to be the next selected item
      
      x = x + 1                                                                                             'Increment the counter
      
     Next SelectedItem                                                                                      'Next item selected
     
     SelectedMakes = Left(SelectedMakes, Len(SelectedMakes) - 1)                                            'Remove the trailing comma
     
     Else
      SelectedMakes = ""
     
    End If                                                                                                  'End check to see if any makes were selected
    
    
    'Check to see if any Series were selected
    If Me.lst_Series.ItemsSelected.Count > 0 Then
     
     x = 1                                                                                                  'Start the counter
     SelectedSeries = " AND [Series AU] IN ("                                                               'Create the first portion of the SQL statement for this criteria
     
     'Loop through each item selected and modify the string the select statement will use in its search
     For Each SelectedItem In Me.lst_Series.ItemsSelected
      SelectedSeries = SelectedSeries & "'" & Me.lst_Series.ItemData(SelectedItem) & "',"                   'Add the item selected to the SQL statement
      
      ReDim Preserve SelectedSeriesArray(1 To x)                                                            'Increase the size of the array
      SelectedSeriesArray(x) = Me.lst_Series.ItemData(SelectedItem)                                         'Assign the next array value to be the next selected item
      
      x = x + 1                                                                                             'Increment the counter
      
     Next SelectedItem                                                                                      'Next item selected
     
     SelectedSeries = Left(SelectedSeries, Len(SelectedSeries) - 1)                                         'Remove the trailing comma from the SQL statement
     SelectedSeries = SelectedSeries & ")"                                                                  'Add a closing parenthesis to the SQL statement
     
     Else
      SelectedSeries = ""                                                                                   'Make the criteria nothing
     
    End If                                                                                                  'End check to see if any Models were selected
    
    
    'Check to see if any Models were selected
    If Me.lst_Model.ItemsSelected.Count > 0 Then
     
     x = 1                                                                                                  'Start the counter
     SelectedModels = " AND [Model] IN ("                                                                   'Create the first portion of the SQL statement for this criteria
     
     'Loop through each item selected and modify the string the select statement will use in its search
     For Each SelectedItem In Me.lst_Model.ItemsSelected
      SelectedModels = SelectedModels & "'" & Me.lst_Model.ItemData(SelectedItem) & "',"                    'Add the item selected to the SQL statement
      
      ReDim Preserve SelectedModelsArray(1 To x)                                                            'Increase the size of the array
      SelectedModelsArray(x) = Me.lst_Model.ItemData(SelectedItem)                                          'Assign the next array value to be the next selected item
      
      x = x + 1                                                                                             'Increment the counter
      
     Next SelectedItem                                                                                      'Next item selected
     
     SelectedModels = Left(SelectedModels, Len(SelectedModels) - 1)                                         'Remove the trailing comma from the SQL statement
     SelectedModels = SelectedModels & ")"                                                                  'Add a closing parenthesis to the SQL statement
     
     Else
      SelectedModels = ""                                                                                   'Make the criteria nothing
     
    End If                                                                                                  'End check to see if any Models were selected
    
    
    'Check to see if any Engines were selected
    If Me.lst_Engine.ItemsSelected.Count > 0 Then
     
     x = 1                                                                                                  'Start the counter
     SelectedEngines = " AND [Engine Description] IN ("                                                     'Create the first portion of the SQL statement for this criteria
     
     'Loop through each item selected and modify the string the select statement will use in its search
     For Each SelectedItem In Me.lst_Engine.ItemsSelected
      SelectedEngines = SelectedEngines & "'" & Me.lst_Engine.ItemData(SelectedItem) & "',"                 'Add the item selected to the SQL statement
     
      ReDim Preserve SelectedEnginesArray(1 To x)                                                           'Increase the size of the array
      SelectedEnginesArray(x) = Me.lst_Engine.ItemData(SelectedItem)                                        'Assign the next array value to be the next selected item
      
      x = x + 1                                                                                             'Increment the counter
      
     Next SelectedItem                                                                                      'Next item selected
     
     SelectedEngines = Left(SelectedEngines, Len(SelectedEngines) - 1)                                      'Remove the trailing comma from the SQL statement
     SelectedEngines = SelectedEngines & ")"                                                                'Add a closing parenthesis to the SQL statement
     
     Else
      SelectedEngines = ""                                                                                  'Make the criteria nothing
     
    End If                                                                                                  'End check to see if any Engines were selected
    
    
    'Check to see if any Transmissions were selected
    If Me.lst_Transmission.ItemsSelected.Count > 0 Then
     
     x = 1                                                                                                  'Start the counter
     SelectedTransmissions = " AND [Transmission Description] IN ("                                         'Create the first portion of the SQL statement for this criteria
     
     'Loop through each item selected and modify the string the select statement will use in its search
     For Each SelectedItem In Me.lst_Transmission.ItemsSelected
      SelectedTransmissions = SelectedTransmissions & "'" & Me.lst_Transmission.ItemData(SelectedItem) & "'," 'Add the item selected to the SQL statement
      
      ReDim Preserve SelectedTransmissionsArray(1 To x)                                                     'Increase the size of the array
      SelectedTransmissionsArray(x) = Me.lst_Transmission.ItemData(SelectedItem)                            'Assign the next array value to be the next selected item
      
      x = x + 1                                                                                             'Increment the counter
      
     Next SelectedItem                                                                                      'Next item selected
     
     SelectedTransmissions = Left(SelectedTransmissions, Len(SelectedTransmissions) - 1)                    'Remove the trailing comma from the SQL statement
     SelectedTransmissions = SelectedTransmissions & ")"                                                    'Add a closing parenthesis to the SQL statement
     
     Else
      SelectedTransmissions = ""                                                                            'Make the criteria nothing
     
    End If                                                                                                  'End check to see if any Transmissions were selected
    
    
    'Check to see if any ManufactureDates were selected
    If Me.lst_ManufactureDate.ItemsSelected.Count > 0 Then
     
     x = 1                                                                                                  'Start the counter
     SelectedManufactureDates = " AND [Manufacture Date AU-From] IN ("                                      'Create the first portion of the SQL statement for this criteria
     
     'Loop through each item selected and modify the string the select statement will use in its search
     For Each SelectedItem In Me.lst_ManufactureDate.ItemsSelected
      SelectedManufactureDates = SelectedManufactureDates & "#" & Me.lst_ManufactureDate.ItemData(SelectedItem) & "#," 'Add the item selected to the SQL statement
      
      ReDim Preserve SelectedManufactureDatesArray(1 To x)                                                  'Increase the size of the array
      SelectedManufactureDatesArray(x) = Me.lst_ManufactureDate.ItemData(SelectedItem)                      'Assign the next array value to be the next selected item
      
      x = x + 1                                                                                             'Increment the counter
      
     Next SelectedItem                                                                                      'Next item selected
     
     SelectedManufactureDates = Left(SelectedManufactureDates, Len(SelectedManufactureDates) - 1)           'Remove the trailing comma from the SQL statement
     SelectedManufactureDates = SelectedManufactureDates & ")"                                              'Add a closing parenthesis to the SQL statement
     
     Else
      SelectedManufactureDates = ""                                                                         'Make the criteria nothing
     
    End If                                                                                                  'End check to see if any ManufactureDates were selected
    
    
    'Set the rowsource on each listbox to pull the appropriate selections
    Me.lst_Model.RowSource = "SELECT DISTINCT [Model] FROM tbl_Vehicles WHERE ([Manufacturer] IN (" & SelectedMakes & ")" & SelectedSeries & SelectedEngines & SelectedTransmissions & SelectedManufactureDates & ") ORDER BY [Model]"
    Me.lst_Series.RowSource = "SELECT DISTINCT [Series AU] FROM tbl_Vehicles WHERE ([Manufacturer] IN (" & SelectedMakes & ")" & SelectedModels & SelectedEngines & SelectedTransmissions & SelectedManufactureDates & ") ORDER BY [Series AU]"
    Me.lst_Engine.RowSource = "SELECT DISTINCT [Engine Description] FROM tbl_Vehicles WHERE ([Manufacturer] IN (" & SelectedMakes & ")" & SelectedModels & SelectedSeries & SelectedTransmissions & SelectedManufactureDates & ") ORDER BY [Engine Description]"
    Me.lst_Transmission.RowSource = "SELECT DISTINCT [Transmission Description] FROM tbl_Vehicles WHERE ([Manufacturer] IN (" & SelectedMakes & ")" & SelectedModels & SelectedSeries & SelectedEngines & SelectedManufactureDates & ") ORDER BY [Transmission Description]"
    Me.lst_ManufactureDate.RowSource = "SELECT DISTINCT [Manufacture Date AU-From] FROM tbl_Vehicles WHERE ([Manufacturer] IN (" & SelectedMakes & ")" & SelectedModels & SelectedSeries & SelectedEngines & SelectedTransmissions & ") ORDER BY [Manufacture Date AU-From]"
    
    
    'Refresh the listboxes
    Me.lst_Model.Requery
    Me.lst_Series.Requery
    Me.lst_Engine.Requery
    Me.lst_Transmission.Requery
    Me.lst_ManufactureDate.Requery
    
    
    'Reselect the selected models
    If Len(Join(SelectedModelsArray)) > 0 Then
     For x = 1 To UBound(SelectedModelsArray)
      
      For y = 0 To Me.lst_Model.ListCount - 1
       If Me.lst_Model.ItemData(y) = SelectedModelsArray(x) Then Me.lst_Model.Selected(y) = True
      Next y                                                                                                'Next item in the listbox
     
     Next x                                                                                                 'Next previously selected item
    End If                                                                                                  'End check to see if there were any previously selected items
    
    
    'Reselect the selected series
    If Len(Join(SelectedSeriesArray)) > 0 Then
     For x = 1 To UBound(SelectedSeriesArray)
      
      For y = 0 To Me.lst_Series.ListCount - 1
       If Me.lst_Series.ItemData(y) = SelectedSeriesArray(x) Then Me.lst_Series.Selected(y) = True
      Next y                                                                                                'Next item in the listbox
     
     Next x                                                                                                 'Next previously selected item
    End If                                                                                                  'End check to see if there were any previously selected items
    
    
    'Reselect the selected engines
    If Len(Join(SelectedEnginesArray)) > 0 Then
     For x = 1 To UBound(SelectedEnginesArray)
      
      For y = 0 To Me.lst_Engine.ListCount - 1
       If Me.lst_Engine.ItemData(y) = SelectedEnginesArray(x) Then Me.lst_Engine.Selected(y) = True
      Next y                                                                                                'Next item in the listbox
     
     Next x                                                                                                 'Next previously selected item
    End If                                                                                                  'End check to see if there were any previously selected items
    
    
    'Reselect the selected transmissions
    If Len(Join(SelectedTransmissionsArray)) > 0 Then
     For x = 1 To UBound(SelectedTransmissionsArray)
      
      For y = 0 To Me.lst_Transmission.ListCount - 1
       If Me.lst_Transmission.ItemData(y) = SelectedTransmissionsArray(x) Then Me.lst_Transmission.Selected(y) = True
      Next y                                                                                                'Next item in the listbox
     
     Next x                                                                                                 'Next previously selected item
    End If                                                                                                  'End check to see if there were any previously selected items
    
    
    'Reselect the selected manufacture dates
    If Len(Join(SelectedManufactureDatesArray)) > 0 Then
     For x = 1 To UBound(SelectedManufactureDatesArray)
      
      For y = 0 To Me.lst_ManufactureDate.ListCount - 1
       If Me.lst_ManufactureDate.ItemData(y) = SelectedManufactureDatesArray(x) Then Me.lst_ManufactureDate.Selected(y) = True
      Next y                                                                                                'Next item in the listbox
     
     Next x                                                                                                 'Next previously selected item
    End If                                                                                                  'End check to see if there were any previously selected items
    
    
    End Sub


  2. #2
    isladogs's Avatar
    isladogs is offline MVP / VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jan 2014
    Location
    Somerset, UK
    Posts
    5,954
    This doesn't answer your question but Access is not designed to work on wireless connections and any break in connection could easily lead to corruption.
    Similarly performance will be poor and issues may arise with VPN /WAN

    For remote connections with Access you need a solution such as Windows Terminal Server or Citrix

    So in summary, a slow connection may be the least of your potential problems.
    Colin, Access MVP, Website, email
    The more I learn, the more I know I don't know. When I don't know, I keep quiet!
    If I don't know that I don't know, I don't know whether to answer

  3. #3
    Micron is offline Virtually Inert Person
    Windows 10 Access 2016
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    Agreed. Possibly you can simply copy from the linked table(s) and store the required data locally. You would have to decide if that's a workable solution because we know nothing of the volatility of that data or your db tool. It would not be too difficult to ensure the data is updated daily, but that may not be good enough for your situation.
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  4. #4
    Perceptus's Avatar
    Perceptus is offline Expert
    Windows 10 Access 2016
    Join Date
    Nov 2012
    Location
    Knoxville, Tennessee
    Posts
    659
    UI updates are notorious for slowing things down, have you tried to disable painting at the beginning of the procedure and re-enabling at the end? If this doesn't fix the issue, I would say yes. Queries are a hangup.

  5. #5
    jjsande1492 is offline Advanced Beginner
    Windows 7 64bit Access 2016
    Join Date
    May 2018
    Posts
    38
    Thanks, everyone.

    From the sounds of it, my query isn't able to be optimised any better than it currently is. I'll give the disabling of painting a shot though. I appreciate the input on the wireless setup. It's not ideal and not often that I get a remote user, so they will simply have to know where in the utility will bog them down.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 35
    Last Post: 03-19-2018, 12:06 AM
  2. Multiselect Multiple Listboxes
    By Deepak.Doddagoudar in forum Forms
    Replies: 29
    Last Post: 03-15-2018, 03:26 PM
  3. Replies: 15
    Last Post: 07-20-2013, 12:42 PM
  4. Replies: 5
    Last Post: 02-05-2013, 01:18 PM
  5. Speeding up Table Linking Times
    By cbh35711 in forum Access
    Replies: 2
    Last Post: 03-27-2012, 03:54 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums