Issue with DLookup when comparing strings in Query - ms-access

I am trying to use Dlookup to look up a value in a query using two criteria ("s" and "Error") to populate variable "SCount". s is an integer for shift number, and Error is a string. Both are fields in the query. The Dlookup is pulling from a query which should be strings for the data type, the query is pulling from a table where the fields are strings. So I am not sure why I am getting a mismatch error.
When I run the code I get the error "Run-time error '3464' Data type mismatch in criteria or expression". For the the Error in the SCount Dlookup.
Code
Dim Error As String
Dim i As Integer
Dim s As Integer
Dim n As Integer
Dim SCount As Variant
Dim sum As Double
sum = 0
i = 1
s = 1
n = 1
Do Until i > 5
If Not IsNull(DLookup("[Type of Error]", "RankedSumOfErrors", "[Ranking] = " & i)) Then
Error = DLookup("[Type of Error]", "RankedSumOfErrors", "[Ranking] = " & i)
Me.Controls("lbl" & i & "").Caption = Error
Do Until s > 3
SCount = DLookup("[SumOfNumber of Errors]", "ErrorsByShift", "[Shift] = " & s & " AND [Type of Error] = '" & Error & "'")
Me.Controls("lbls" & s & "").Caption = SCount
i = i + 1
sum = sum + SCount
Loop
Me.Controls("Total" & i & "").Caption = sum
sum = 0
Else
Me.Controls("lbl" & i & "").Caption = "N/A"
i = i + 1
End If
Loop

If the fields are strings in the query, they should be so as well in the DLookUp.
Add parentheses to your DLookUp to avoid the error:
SCount = DLookup("[SumOfNumber of Errors]", "ErrorsByShift", "[Shift] = '" & s & "' AND [Type of Error] = '" & Error & "'")

Related

Dynamic variable holder with counter

I have two txt boxes and two combo boxes on a form. There is also a subform linked to the temptable that I want to have rebuilt/filter each time one of the controls is changed (using after update on each control to trigger the following sub)
I receive Run-time error '91: Object variable or with block variable not set on line Items(i) = Thing
I am not sure using " (i) " works with MS Access 365 or I am dimensioning incorrectly?
Thank you.
Private Sub Lookupstuff()
Dim i As Integer
Dim Items(1 To 4) As Object
sql = "DELETE * FROM tblTemp"
CurrentDb.Execute sql
i = 0
FilterArray = Array(Me.txtNew, Me.cmbS, Me.cmbP, Me.txtSl)
For Each Thing In FilterArray
If Not IsNull(Thing) Then
i = i + 1
Items(i) = Thing <--Error is here. Items(i) is empty.
End If
Next
If i = 0 Then
Forms!frmNew.Requery
Forms!frmNew.Refresh
End If
If i = 1 Then
Filter = Items1
End If
If i = 2 Then
Filter = Items1 & " AND " & Items2
End If
If i = 3 Then
Filter = Items1 & " AND " & Items2 & " AND " & Items3
End If
If i = 4 Then
Filter = Items1 & " AND " & Items2 & " AND " & Items3 & " AND " & Items4
End If
sql = "INSERT INTO tblTemp SELECT * FROM tblQ"
If Not IsNull(Filter) Then
sql = sql & " WHERE " & Filter
End If
CurrentDb.Execute sql
Forms!frmNew.Requery
Forms!frmNew.Refresh
End Sub
Since you are assigning a reference to object in the array, you must use Set, i.e.:
Set Items(i) = Thing
Also, presumably each reference to Items1, Items2 etc. should actually be Items(1), Items(2) in order to access the objects referenced at these indices of the array.

Indexing in VBA (Access 2003) - field association

Based on this tutorial page, how does Microsoft Access know that a field created for an index fields collection associates to an equivalent field in the TableDef fields collection?
Even in this Microsoft Support page, fields are created for the index and then appended to the index's fields collection:
...
'Copy Indexes
For I1 = 0 To SourceTableDef.Indexes.Count - 1
Set SI = SourceTableDef.Indexes(I1)
If Not SI.Foreign Then ' Foreign indexes are added by relationships
Set I = T.CreateIndex()
' Copy Jet Properties
On Error Resume Next
For P1 = 0 To I.Properties.Count - 1
I.Properties(P1).Value = SI.Properties(P1).Value
Next P1
On Error GoTo 0
' Copy Fields
For f1 = 0 To SI.Fields.Count - 1
Set F = T.CreateField(SI.Fields(f1).Name, T.Fields(SI.Fields(f1).Name).Type)
I.Fields.Append F
Next f1
T.Indexes.Append I
End If
Next I1
...
Can't I simply add the existing field from the TableDef's fields collection? This makes little sense and seems to have very little in the way of cohesion.
Update
I actually tested the code here which is basically what I want to do ... but it fails with an undefined object error on this line:
Set F = T.CreateField(SI.Fields(f1).Name, T.Fields(SI.Fields(f1).Name).Type)
...and we have all sorts of fun when we change this.
(23/05/2016) Further, this script appears to be wrong - the second argument shouldn't actually be there, it's unnecessary. Omitting it causes further errors! Ha! Where's my tail? I'm getting the feeling that I should be chasing it.
A solution to my problem
I decided to follow HansUp's lead and use DDL - far easier than attempting to trawl through the problems associated to the manipulation of objects (though there was some level of this in the final code design)...
Option Compare Database
Public Const cFname As String = "drm\drmData2016.accdb"
Public Const cPropNotFound As Integer = 3270
Public Const cNotSupported As Integer = 3251
Public Const cInvalidOp As Integer = 3219
Public Sub GenerateTables()
OpenLog
'Initalise...
Dim db As Database
Dim tdb As Database
Dim ts As TableDef, tt As TableDef
Dim p As Property
Dim f As Field, ft As Field
Dim i As Index
Dim s As String, t As String
Dim x As Boolean
Set db = CurrentDb
If Dir$(cFname) <> "" Then Kill cFname
Set tdb = Application.DBEngine.CreateDatabase(cFname, dbLangGeneral, dbVersion140)
WriteLog "Created database " & cFname & "."
'Create the tables...
WriteLog "Creating TableDefs...", 1
For Each ts In db.TableDefs
If Not StartsWith(ts.Name, "msys", "~", "$", "Name AutoCorrect") And Not EndsWith(ts.Name, "_xrep") Then
s = "SELECT "
For Each f In ts.Fields
If Not StartsWith(f.Name, "s_", "S_") Then s = s & "[" & f.Name & "], "
Next f
s = Left$(s, Len(s) - 2) & " INTO [" & ts.Name & "] IN """ & cFname & """ FROM [" & ts.Name & "];"
On Error Resume Next
db.Execute s
If Err.Number = 0 Then
WriteLog "Created [" & ts.Name & "] using " & s, 2
Else
WriteLog "Failed to create [" & ts.Name & "].", 2
WriteLog "Error " & Err.Number & ": " & Err.Description, 3
WriteLog "SQL: " & s, 3
Err.Clear
End If
tdb.TableDefs.Refresh
On Error GoTo 0
End If
Next ts
'Copy the properties...
WriteLog "Tables...", 1
For Each ts In db.TableDefs
If Not StartsWith(ts.Name, "msys", "~", "$", "Name Autocorrect") And Not EndsWith(ts.Name, "_xrep") Then
Set tt = tdb.TableDefs(ts.Name)
WriteLog ts.Name, 2
WriteLog "Table Properties...", 3
'Table properties...
For Each p In ts.Properties
On Error Resume Next
tt.Properties(p.Name) = p.value
If Err.Number = 0 Then
WriteLog p.Name & " = " & p.value, 3
Else
WriteLog "Error setting " & p.Name, 3
WriteLog Err.Number & ": " & Err.Description, 4
Err.Clear
End If
On Error GoTo 0
Next p
'Field properties...
WriteLog "Fields...", 3
For Each f In ts.Fields
If Not StartsWith(f.Name, "s_") Then
Set ft = tt.Fields(f.Name)
WriteLog f.Name, 3
WriteLog "Properties...", 3
For Each p In f.Properties
On Error Resume Next
ft.Properties(p.Name).value = p.value
Select Case Err.Number
Case 0
'Normal...
WriteLog p.Name & " = " & p.value, 4
Case cPropNotFound
'Create the property...
Dim np As Property
Set np = ft.CreateProperty(p.Name, p.Type, p.value)
ft.Properties.Append np
ft.Properties.Refresh
WriteLog "Created property " & p.Name & ", value of " & p.value, 4
Case cNotSupported, cInvalidOp
'We're not worried about these values - simply skip over them...
Case Else
WriteLog "Failed to create or change property " & p.Name & ".", 4
WriteLog "Error " & Err.Number & ": " & Err.Description, 5
Err.Clear
End Select
On Error GoTo 0
Next p
End If
Next f
'Create the indexes...
WriteLog "Table indexes...", 2
For Each i In ts.Indexes
x = False
s = "CREATE "
If i.Unique Then s = s & "UNIQUE "
s = s & "INDEX [" & i.Name & "] ON [" & ts.Name & "] ("
For Each f In i.Fields
s = s & "[" & f.Name & "], "
'Just make sure we're not dealing with replication fields...
x = StartsWith(f.Name, "s_")
Next f
'We only want
If Not x Then
WriteLog i.Name, 3
s = Left$(s, Len(s) - 2) & ") "
If i.Primary Or i.IgnoreNulls Or i.Required Then
s = s & "WITH "
If i.Primary Then s = s & "PRIMARY "
If i.IgnoreNulls Then s = s & "IGNORE NULL "
If i.Required Then s = s & "DISALLOW NULL "
End If
s = s & ";"
On Error Resume Next
tdb.Execute s
Select Case Err.Number
'Note: used select case just in case I need to add extra error numbers...
Case 0
'Normal...
WriteLog "Created index [" & i.Name & "] using " & s, 4
Case Else
WriteLog "Failed to create index [" & ts.Name & "].", 4
WriteLog "Error " & Err.Number & ": " & Err.Description, 5
WriteLog "SQL: " & s, 3
Err.Clear
End Select
On Error GoTo 0
End If
Next i
End If
Next ts
'Belt and braces tidy-up...
Set p = Nothing
Set f = Nothing
Set ft = Nothing
Set i = Nothing
Set ts = Nothing
Set tt = Nothing
tdb.Close
Set tdb = Nothing
Set db = Nothing
WriteLog "Closed database."
WriteLog "Finished.", , False
CloseLog
End Sub
how does Microsoft Access know that a field created for an index
fields collection associates to an equivalent field in the TableDef
fields collection?
It checks based on the name. The name of the new index field must exist in the TableDef and that field's datatype must be one which is indexable. If either of those conditions is not satisfied, you will get an error message.
In summary:
An index is (from DAO point of view) basically a data structure with some properties and a collection of field names + their data types.
It is not a collection of pointers to tabledef fields.
To add fields to an index via DAO one needs a field object, which is created by CreateField().
The index object has a .CreateField() method too, which is actually the more common way to do this, I'd say.
From http://allenbrowne.com/func-dao.html#CreateIndexesDAO :
'3. Multi-field index.
Set ind = tdf.CreateIndex("FullName")
With ind
.Fields.Append .CreateField("Surname")
.Fields.Append .CreateField("FirstName")
End With
tdf.Indexes.Append ind
Note that this method doesn't take the Type and Size parameters, only the Name. I will happily admit that all this is a bit confusing (or incoherent, if you want).

MS Access DLOOKUP with text and nested DLOOKUP for criteria

I have a combobox on a form that contains search terms. The user chooses a search term and this looks up to a table containing the number X. The RVU (a number) of X is looked up in another table given the category is equal to the string 'PHYS'. I was using nested DLOOKUP statements to look up the number X and then use that number X and the string criteria to look up the RVU. Here's my code:
FH_array(0) = Val(Nz(DLookup("[RVU]", "[FORES IP Picker]", "[IP]= " & Val(Nz(DLookup("[FORES]", "[IP Number Xwalk]", "[Reference Name] = '" & Me.Ref_Name & "'"), 0))), ""))
I wasn't having luck so I broke it down to debug:
a = Val(Nz(DLookup("[FORES]", "[IP Number Xwalk]", "[Reference Name] = '" & Me.Ref_Name & "'"), 0))
Debug.Print "a:"; a 'returns value 279
aa = Val(nz(DLookup("[RVU]", "[FORES IP Picker]", "[IP] = " & a & " and [Cost Category] = 'PHYS')))
Debug.Print "aa:"; aa
I'm getting a syntax error on the line for variable aa. if I changed the code from
aa = DLookup("[RVU]", "[FORES IP Picker]", "[IP] = " & a & " and [Cost Category] = 'PHYS')
to
aa = DLookup("[RVU]", "[FORES IP Picker]", "[Cost Category] = 'PHYS'" And "[IP] = " & a)
I get a run-time error 13 type mismatch
All the variables are declared as variant and called properly. The array FH_array is sized correctly. I copied this code from another database that does the same type of nested DLOOKUP but it has only one criteria and therefore works. I can't figure out what syntax I'm missing or where the type mismatch is to get it to work.
You need a single valid string as the DLookup criteria option. Use the Immediate window to examine what you have for the criteria in the final DLookup example.
Debug.Print "[Cost Category] = 'PHYS'" And "[IP] = " & a
That is actually a "logical conjunction" of two strings. (That will make more sense if you review the Access help topic for the And Operator.)
And since you're using And with two string expressions, Access complains about type mismatch, the same as it does with this simpler example:
Debug.Print "a" And "b"
So you need to create a single valid string for the criteria option ...
a = 279
Debug.Print "[Cost Category] = 'PHYS' And [IP] = " & a
[Cost Category] = 'PHYS' And [IP] = 279
Translating that back to the last DLookup in your question ...
Dim strCriteria As String
strCriteria = "[Cost Category] = 'PHYS' And [IP] = " & a
Debug.Print strCriteria ' <- just to make sure you got what you need
aa = DLookup("[RVU]", "[FORES IP Picker]", strCriteria)

Using array in WHERE clause of SQL statement using access VBA

I have an array ListBoxContents(), it will contain the items like '15', '16','25'..upto 10 items. I'm trying to retrieve data in the column Bnumber where data of length >6 and starting with('15', '16','25'...) i.e those items specified in listbox .And trying to query these listbox items in where cluase of the sql statement
Table column Bnumber contains
Bnumber
152
156
1523
16417
AA454
CC654
18A16
1826
18A16
25A76
54A16
54235A68
My VBA code
Private Sub arraywhere()
Dim qry As String
Dim Size As Integer
Size = Form_Input_From.lstdigits.ListCount - 1
ReDim ListBoxContents(0 To Size) As String
ReDim LContents(0 To 30) As String
Dim m As Integer
For m = 0 To Size
ListBoxContents(m) = Form_Input_From.lstdigits.ItemData(m)
Next m
For m = 0 To Size
qry = "SELECT col1,col2,Bnumber " & _
"FROM table WHERE (Len([table].[Bnumber]))>6) AND (Left
([table].[Bnumber],2))=(" & ListBoxContents(m) & ");"
Next m
Debug.Print qry
Application.CurrentDb.QueryDefs("[arrayqry]").sql = qry
DoCmd.OpenQuery "[arrayqry]"
End Sub
But my WHERE clause reads only last array item only. How do i specify array in where clause?
Try something like
" ... ([table].[Bnumber],2)) in ('" & Join(ListBoxContents,"','") & "');"
You are setting qry to a new statement with each iteration of your for loop. Instead you need to concatenate a string based on your list box contents that will look like ("x", "y", "z") and replace = with in.
Finish by setting your query once it will look similar to this:
qry = "SELECT col1,col2,Bnumber " & _
"FROM table WHERE (Len([table].[Bnumber]))>6) AND (Left
([table].[Bnumber],2)) in (" & commaSeperatedContents & ");"
Where commaSeperatedContents is a String that is like ("x", "y", "z") but of course has your values.
Try this one:
Dim inPart As String
For m = 0 To Size
inPart = inPart & "'" & ListBoxContents(m) & "',"
Next m
inPart = Left(inPart, Len(inPart) - 1)
qry = "SELECT col1,col2,Bnumber " & _
"FROM [table] WHERE Len([table].[Bnumber])>6 AND " & _
"Left([table].[Bnumber],2) In (" & inPart & ");"
Debug.Print qry
CurrentDb.QueryDefs("[arrayqry]").SQL = qry
DoCmd.OpenQuery "arrayqry"
The list of items in your array actually seems to be coming from the Form_Import_From_PMT.lstdigits control. Is this control bound to a data source? If so, you can simply join your table to that data source with a join clause that specifies that only rows with Bnumber values starting with the digits in the joined table are to be selected:
select col1, col2, Bnumber
from table as t
inner join tblDigits as d
on left(t.Bnumber, 2) = d.Digits
where len(t.Bnumber) > 6
If the control is not bound to a data source, then bind it now (creating a new table tblDigits to hold the digits, as shown above), and you'll be able to use the above query.
In short, data binding is how you 'use an array in a where clause' in Access.

Excel VBA - Running SQL script multiple times with different variable value

I want to run a script in my macro multiple times by changing variable values.
Below is an example of my code that I run for one value.
The line of code I would like to change is
sScript = sScript + "where m.outletid in ('" & sOutletId & "') " & vbCrLf
Sometime I want the where clause to be
where m.outletid in ('12314')
or
where m.chainid in ('411')...
Code:
Sub Report()
Dim sScript As String
Dim sServer As String
Dim sDatabase As String
Dim sTransTable As String
Dim iVal As Integer
Dim iReturnVal As Integer
Dim SheetExists As Worksheet
Dim WK_SHEET As String
sServer = Trim(UserForm1.txtServer.Value)
sDatabase = Trim(UserForm1.txtDatabase.Value)
sTransTable = Trim(UserForm1.txtTransTable.Value)
For Each SheetExists In Worksheets
If SheetExists.Name = ("Report") Then
Application.DisplayAlerts = False
Sheets("Report").Delete
Application.DisplayAlerts = True
Exit For
End If
Next SheetExists
Worksheets.Add after:=Sheets("Sheet1")
ActiveSheet.Name = ("Report")
WK_SHEET = "Report"
Sheets(WK_SHEET).Select
sOutletId = "12314"
sScript = "Select top 10 m.CustNumber, m.Name, sum(t.Transvalue) " & vbCrLf
sScript = sScript + "from " & sTransTable & " t " & vbCrLf
sScript = sScript + "where m.outletid in ('" & sOutletId & "') " & vbCrLf
sScript = sScript + "Group by m.CustNumber, m.Name " & vbCrLf
sScript = sScript + "order by sum(t.Transvalue)Desc " & vbCrLf
iReply = MsgBox(Prompt:="Do you wish to continue with the following script for Top 10 Customers?" + sScript + "", _
Buttons:=vbYesNo, Title:="Run MACRO Top 10 Reports")
If iReply = vbNo Then
End
End If
iVal = execute_sql_select(WK_SHEET, 2, 1, sServer, sDatabase, sScript)
Sheets(WK_SHEET).Name = "Outlet" & sOutletId & "Top 10 by Spend"
Now I would like to re run the above with OutletId 12315...how can I do this? Do I use some sort of loop?
You can keep list of OutletId into Array. Then get each OutletId from Array (for loop) and execute your sql script.
Pseudu code
Array listOutid = new Array[12,13,14,15];
for(int idx = 0; idx < listOutid.Length; idx++)
{
var OutletId = listOutid[idx];
//put ur sql statement and execute here..
}