Hi Folks, i'm hoping someone might be able to help me out...
I've been working on a new access dbase to allow some not very technical colleagues to interogate a dataset provided by a partner organisation, so i did a bit of digging and found some vba code to generate an 'ad-hoch' set of criteria based on selecting from list boxes in a form.
The dataset provided by our partners [WZ Data] is supplied with all the numerical values from their lookup tables so i have had to replicate these as best as i can (lookup_********) which has made the resultant query full of inner joins and a bit too comlex for me to work out why instead of returning 170,000 records when i run the sheet with no criteria selected, it is only returning 70!
please help
I've been working on a new access dbase to allow some not very technical colleagues to interogate a dataset provided by a partner organisation, so i did a bit of digging and found some vba code to generate an 'ad-hoch' set of criteria based on selecting from list boxes in a form.
The dataset provided by our partners [WZ Data] is supplied with all the numerical values from their lookup tables so i have had to replicate these as best as i can (lookup_********) which has made the resultant query full of inner joins and a bit too comlex for me to work out why instead of returning 170,000 records when i run the sheet with no criteria selected, it is only returning 70!
please help
Code:
Private Sub cmdRunMultiSelect_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim blnQueryExists As Boolean
Dim varItem As Variant
Dim strWard As String
Dim strMainFuelType As String
Dim strPropertyType As String
Dim strLoftInsulation As String
Dim strWallMaterial As String
Dim strDescription As String
Dim strMainFuelTypeCondition As String
Dim strPropertyTypeCondition As String
Dim strLoftInsulationCondition As String
Dim strDescriptionCondition As String
Dim strWallMaterialCondition As String
Dim strSQL As String
' Check for the existence of the stored query
Set db = CurrentDb
blnQueryExists = False
For Each qdf In db.QueryDefs
If qdf.Name = "qryMultiSelect" Then
blnQueryExists = True
Exit For
End If
Next qdf
' Create the query if it does not already exist
If blnQueryExists = False Then
Set qdf = db.CreateQueryDef("qryMultiSelect")
End If
Application.RefreshDatabaseWindow
' Close the query if it is already open
If SysCmd(acSysCmdGetObjectState, acQuery, "qryMultiSelect") = acObjStateOpen Then
DoCmd.Close acQuery, "qryMultiSelect"
End If
' Build criteria string for Ward
For Each varItem In Me.lstWard.ItemsSelected
strWard = strWard & ",'" & Me.lstWard.ItemData(varItem) & "'"
Next varItem
If Len(strWard) = 0 Then
strWard = "Like '*'"
Else
strWard = Right(strWard, Len(strWard) - 1)
strWard = "IN(" & strWard & ")"
End If
' Build criteria string for MainFuelType
For Each varItem In Me.lstMainFuelType.ItemsSelected
strMainFuelType = strMainFuelType & ",'" & Me.lstMainFuelType.ItemData(varItem) & "'"
Next varItem
If Len(strMainFuelType) = 0 Then
strMainFuelType = "Like '*'"
Else
strMainFuelType = Right(strMainFuelType, Len(strMainFuelType) - 1)
strMainFuelType = "IN(" & strMainFuelType & ")"
End If
' Build criteria string for PropertyType
For Each varItem In Me.lstPropertyType.ItemsSelected
strPropertyType = strPropertyType & ",'" & Me.lstPropertyType.ItemData(varItem) & "'"
Next varItem
If Len(strPropertyType) = 0 Then
strPropertyType = "Like '*'"
Else
strPropertyType = Right(strPropertyType, Len(strPropertyType) - 1)
strPropertyType = "IN(" & strPropertyType & ")"
End If
' Build criteria string for Description
For Each varItem In Me.lstDescription.ItemsSelected
strDescription = strDescription & ",'" & Me.lstDescription.ItemData(varItem) & "'"
Next varItem
If Len(strDescription) = 0 Then
strDescription = "Like '*'"
Else
strDescription = Right(strDescription, Len(strDescription) - 1)
strDescription = "IN(" & strDescription & ")"
End If
' Build criteria string for WallMaterial
For Each varItem In Me.lstWallMaterial.ItemsSelected
strWallMaterial = strWallMaterial & ",'" & Me.lstWallMaterial.ItemData(varItem) & "'"
Next varItem
If Len(strWallMaterial) = 0 Then
strWallMaterial = "Like '*'"
Else
strWallMaterial = Right(strWallMaterial, Len(strWallMaterial) - 1)
strWallMaterial = "IN(" & strWallMaterial & ")"
End If
' Build criteria string for LoftInsulation
For Each varItem In Me.lstLoftInsulation.ItemsSelected
strLoftInsulation = strLoftInsulation & ",'" & Me.lstLoftInsulation.ItemData(varItem) & "'"
Next varItem
If Len(strLoftInsulation) = 0 Then
strLoftInsulation = "Like '*'"
Else
strLoftInsulation = Right(strLoftInsulation, Len(strLoftInsulation) - 1)
strLoftInsulation = "IN(" & strLoftInsulation & ")"
End If
' Get MainFuelType condition
If Me.optAndMainFuel.Value = True Then
strMainFuelTypeCondition = " AND "
Else
strMainFuelTypeCondition = " OR "
End If
' Get PropertyType condition
If Me.OptAndPropertyType.Value = True Then
strPropertyTypeCondition = " AND "
Else
strPropertyTypeCondition = " OR "
End If
' Get LoftInsulation condition
If Me.optAndLoftInsulation.Value = True Then
strLoftInsulationCondition = " AND "
Else
strLoftInsulationCondition = " OR "
End If
' Get Description condition
If Me.OptAndDescription.Value = True Then
strDescriptionCondition = " AND "
Else
strDescriptionCondition = " OR "
End If
' Get WallMaterial condition
If Me.OptAndWallMaterial.Value = True Then
strWallMaterialCondition = " AND "
Else
strWallMaterialCondition = " OR "
End If
' Build SQL statement
strSQL = "SELECT tblAreaMatch.Ward , tblAreaMatch.LSOA, [WZ Data].UPRN, tblAddress.Sub_Building, tblAddress.Building, tblAddress.Building_Number, tblAddress.location, tblAddress.Street_Name, tblAddress.Posttown, " & _
"tblAddress.Postcode , lookup_buildyear.BuildYear, lookup_residencetype.[residence type], lookup_mainfueltype.MainFuelType, lookup_PropertyType.PropertyType, lookup_wallmaterial.wallmaterial, lookup_roomheatertype.roomheatertype, lookup_loftinsulation.Loftinsulation, " & _
"[WZ Data].Pre_Sap, [WZ Data].Post_Sap, [WZ Data].Pre_CI, [WZ Data].Post_CI, [WZ Data].Pre_FP, [WZ Data].Post_FP, [WZ Data].ContractorsJobNo, [WZ Data].Description, [WZ Data].healthproblems, [WZ Data].Stroke_Thrombosis, " & _
"[WZ Data].HeartProblems, [WZ Data].RespiratoryProblems, [WZ Data].MobilityProblems, [WZ Data].MajorSurgeryLast3Months, [WZ Data].LongTermCondition, [WZ Data].CMDetector, [WZ Data].BEAdvice, lookup_income.Income " & _
"FROM lookup_wallmaterial INNER JOIN (lookup_income INNER JOIN ((lookup_loftinsulation INNER JOIN (lookup_roomheatertype INNER JOIN (lookup_mainfueltype INNER JOIN (lookup_PropertyType INNER JOIN (lookup_residencetype INNER JOIN (([WZ Data] INNER JOIN tblAddress ON [WZ Data].UPRN = tblAddress.UPRN) LEFT JOIN lookup_buildyear ON [WZ Data].BuildYear = lookup_buildyear.Key) ON lookup_residencetype.key = [WZ Data].ResidenceType) ON lookup_PropertyType.key = [WZ Data].PropertyType) ON lookup_mainfueltype.key = [WZ Data].MainFuelType) ON lookup_roomheatertype.key = [WZ Data].RoomHeaterType) ON lookup_loftinsulation.key = [WZ Data].LoftInsulation) INNER JOIN tblAreaMatch ON ([WZ Data].UPRN = tblAreaMatch.UPRN) AND (tblAddress.UPRN = tblAreaMatch.UPRN)) ON (lookup_income.key = lookup_loftinsulation.key) AND (lookup_income.key = [WZ Data].Income)) ON (lookup_income.key = lookup_wallmaterial.key) AND (lookup_wallmaterial.key = [WZ Data].WallMaterial) " & _
"WHERE tblAreaMatch.[Ward] " & strWard & _
strMainFuelTypeCondition & "lookup_mainfueltype.mainfueltype " & strMainFuelType & _
strPropertyTypeCondition & "lookup_propertytype.propertytype " & strPropertyType & _
strLoftInsulationCondition & "lookup_loftinsulation.loftinsulation " & strLoftInsulation & _
strDescriptionCondition & "[WZ Data.Description] " & strDescription & _
strWallMaterialCondition & "lookup_WallMaterial.WallMaterial " & strWallMaterial & ";"
' Apply the SQL statement to the stored query
Set db = CurrentDb
Set qdf = db.QueryDefs("qryMultiSelect")
qdf.SQL = strSQL
Set qdf = Nothing
Set db = Nothing
' Open the Query
DoCmd.OpenQuery "qryMultiSelect"
' If required the dialog can be closed at this point
' DoCmd.Close acForm, Me.Name
End Sub
Private Sub OptAndMainFuel_Click()
If Me.optAndMainFuel.Value = True Then
Me.optOrMainFuel.Value = False
Else
Me.optOrMainFuel.Value = True
End If
End Sub
Private Sub OptAndPropertyType_Click()
If Me.OptAndPropertyType.Value = True Then
Me.OptOrPropertyType.Value = False
Else
Me.OptOrPropertyType.Value = True
End If
End Sub
Private Sub OptOrMainFuel_Click()
If Me.optOrMainFuel.Value = True Then
Me.optAndMainFuel.Value = False
Else
Me.optAndMainFuel.Value = True
End If
End Sub
Private Sub OptOrPropertyType_Click()
If Me.OptOrPropertyType.Value = True Then
Me.OptAndPropertyType.Value = False
Else
Me.OptAndPropertyType.Value = True
End If
End Sub
Private Sub OptOrLoftInsulation_Click()
If Me.OptOrLoftInsulation.Value = True Then
Me.optAndLoftInsulation.Value = False
Else
Me.optAndLoftInsulation.Value = True
End If
End Sub
Private Sub OptAndLoftInsulation_Click()
If Me.optAndLoftInsulation.Value = True Then
Me.OptOrLoftInsulation.Value = False
Else
Me.OptOrLoftInsulation.Value = True
End If
End Sub
Private Sub OptOrDescription_Click()
If Me.OptOrDescription.Value = True Then
Me.OptAndDescription.Value = False
Else
Me.OptAndDescription.Value = True
End If
End Sub
Private Sub OptAndDescription_Click()
If Me.OptAndDescription.Value = True Then
Me.OptOrDescription.Value = False
Else
Me.OptOrDescription.Value = True
End If
End Sub
Private Sub OptOrWallMaterial_Click()
If Me.OptOrWallMaterial.Value = True Then
Me.OptAndWallMaterial.Value = False
Else
Me.OptAndWallMaterial.Value = True
End If
End Sub
Private Sub OptAndWallMaterial_Click()
If Me.OptAndWallMaterial.Value = True Then
Me.OptOrWallMaterial.Value = False
Else
Me.OptOrWallMaterial.Value = True
End If
End Sub
