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