Guys i have this function which some of you helped me with. I tried to add one condition and i couldn’t
My Function:
Sub MakeNum2()
Dim rs As DAO.Recordset, intS As Integer, strG As String
Set rs = CurrentDb.OpenRecordset("SELECT [Warehouse] & [TransType] AS Grp, TblImportTemp.zdate, TblImportTemp.Doc From TblImportTemp ORDER BY [Warehouse] & [TransType], TblImportTemp.zdate;")
strG = rs!grp
While Not rs.EOF
If strG = rs!grp Then
intS = intS + 1
rs.Edit
rs!Doc = intS
rs.Update
rs.MoveNext
Else
intS = 0
strG = rs!grp
End If
Wend
End Sub
I don’t need it to start the serializing from Number 1 So The Condition i need to add is to get the last Doc Number From QryLastDoc where Grp (In My Function) = Grp2 In QryLastDoc And Set this number as the beginning of Serial then proceed to add 1 for each new doc as usual.
QryLastDoc
SELECT QryTransTopDoc.Warehouse, QryTransTopDoc.Type, Last(QryTransTopDoc.Doc) AS LastOfDoc, [Warehouse] & [Type] AS Grp2
FROM QryTransTopDoc
GROUP BY QryTransTopDoc.Warehouse, QryTransTopDoc.Type, [Warehouse] & [Type];
The Result: the first record will be the last doc number from QryLastDoc +1 then the following will be doc+1 Thanks in Advance
EDIT #1 : It couldn’t be done by Dlookup Guys
`intS = Nz(DLookup("Doc", "QryTransTopDoc", "Grp2='" & rs!Grp & "'"), 0)`
Dlookup Result will be the ground number for serializing meaning the first record DOC will be Dlookup+1 then the following records will be DOC+1 I wish i could explain more . Thanks again
Could use DLookup() domain aggregate function to pull last value generated to set variable with initial value outside loop. Then increment the variable within loop.
Dim rs As DAO.Recordset, intS As Integer, strG As String
Set rs = CurrentDb.OpenRecordset("SELECT [Warehouse] & [TransType] AS Grp, TblImportTemp.zdate, TblImportTemp.Doc From TblImportTemp ORDER BY [Warehouse] & [TransType], TblImportTemp.zdate;")
intS = Nz(DLookup("Doc", "QryTransTopDoc", "Grp2='" & rs!Grp & "'"), 0)
strG = rs!grp
While Not rs.EOF
If strG = rs!grp Then
intS = intS + 1
rs.Edit
rs!Doc = intS
rs.Update
rs.MoveNext
Else
intS = Nz(DLookup("Doc", "QryTransTopDoc", "Grp2='" & rs!Grp & "'"), 0)
strG = rs!grp
End If
Wend
Or use DMax() on table.
Alternatively, don't save this value to table and instead calculate when needed. MS Access Restart Number Sequence
Related
I have a access table that I am doing a search by date range on. In the form I have a text box TxtTotal that I want to display the number of records in the filtered range the code I have. keeps giving me the complete number of records and not the range filtered.
This is my module
Function FindRecordCount(strSQL As String) As Long
Dim db As Database
Dim rstRecords As Recordset
'On error GoTo ErrorHandler
Set db = CurrentDb
Set rstRecords = db.OpenRecordset("TblPurchases")
If rstRecords.EOF Then
FindRecordCount = 0
Else
rstRecords.MoveLast
FindRecordCount = rstRecords.RecordCount
End If
rstRecords.Close
db.Close
Set rstRecords = Nothing
Set db = Nothing
End Function
This is my code for the TxtTotal text box on the form
Sub Search()
Dim strCriteria, task As String
Me.Refresh
If IsNull(Me.TxtPurchaseDateFrom) Or IsNull(Me.TxtPurchaseDateTo)
Then
MsgBox "Please enter the date range", vbInformation, "Date Range
Required"
Me.TxtPurchaseDateFrom.SetFocus
Else
strCriteria = "([Date of Purchase] >= #" & Me.TxtPurchaseDateFrom &
"# and [Date of Purchase] <= #" & Me.TxtPurchaseDateTo & "#)"
task = "select * from TblPurchases where( " & strCriteria & ") order
by [Date of Purchase] "
DoCmd.ApplyFilter task
Me.TxtTotal = FindRecordCount(task)
End If
End Sub
the results keeps giving me the complete number of records and not the range filtered.
I believe the main issue is this line:
Set rstRecords = db.OpenRecordset("TblPurchases")
You are setting the Record set to use the table as its source instead of your SQL string. No matter what your input dates are, if you are looking at the whole table, it will return the whole table xD.
As for finding the total count of items from a query result, it might make sense to use the SQL COUNT function eg: SELECT COUNT(<Column>) FROM <table> WHERE <criteria>; This will provide you the number of data entries that are provided from that query.
I would also recommend using the QueryDef Object for your SQL definitions since it makes things a little cleaner. But again, this is just a recommendation EG:
Function FindRecordCount(dateFrom As Date, dateTo As Date) As Long
Dim db As DAO.Database
Dim QDF As DAO.QueryDef
Dim rstRecords As DAO.Recordset
Dim SQL As String
SQL = "SELECT COUNT(*) FROM TblPurchase WHERE([Date of Purchase] >= ##dateFrom# AND [Date of Purchase] <= ##dateTo#)"
Set db = CurrentDb
Set QDF = db.QuerDefs(SQL)
QDF.Paramaters("#dateFrom").Value = dateFrom
QDF.Paramaters("#dateTo").Value = dateTo
Set rstRecords = QDF.OpenRecordset("TblPurchases")
If rstRecords.EOF Then
FindRecordCount = 0
Else
rstRecords.MoveLast
FindRecordCount = rstRecords.RecordCount
End If
rstRecords.Close
QDF.Close
db.Close
Set rstRecords = Nothing
Set QDF = Nothing
Set db = Nothing
End Function
Best Regards.
You could replace all this with a DCount expression in the ControlSource of the textbox txtTotal:
=DCount("*","TblPurchase ","[Date of Purchase] Between #" & Format(Nz(Me!TxtPurchaseDateFrom.Value,Date()), "yyyy\/mm\/dd") & "# And #" & Format(Nz(Me!TxtPurchaseDateTo.Value,Date()), "yyyy\/mm\/dd") & "#")
This code is written in Excel2010 VBA and queries PostGreSQL tables
I have the following code in VBA that creates a variable that I would like to use in my SQL query, but I cannot get the SQL query to accept the VBA variable using the IN clause
This code creates the variable I want to use and works fine. It allows me to select specific cells I need to query
Dim StaffID As Range
Dim ID As Range
Dim LR As Long
Dim SelectedID As String
'Count number of rows to search
LR = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next 'if only 1 row
'Store Data from here
Set StaffID = ThisWorkbook.Sheets("Sheet1").Range("B2:B" & LR)
'Loop through each cell in Range and look for any character in column A
'then store offset cell value using comma delimiter
For Each ID In Worksheets("Sheet1").Range("A2:A" & LR).Cells
If ID.Value > 0 Then
SelectedID = SelectedID & "," & ID.Offset(, 1).Value
End If
Next ID
'Remove first delimiter from string (,)
SelectedID = Right(SelectedID, Len(SelectedID) - 1)
OUTPUT EXAMPLE of SelectedID = 6,7,8,6452
I now want to add this to my query using the IN clause, but it just doesn't work. Does anyone have a solution or workaround.
Sheets("Sheet2").Select
Range("A1").Select
Dim rs As Recordset
Dim t As String
t = "SELECT DISTINCT s.entity_id, u.login_name, s.role " _
& "FROM staff s INNER JOIN user u ON s.entity_id=u.staff_id " _
& "WHERE u.staff_id IN (SelectedID) " _
Set rs = conn.Execute(t)
With ActiveSheet.QueryTables.Add(Connection:=rs, Destination:=Range("A1"))
.Refresh
End With
rs.Close
At the moment you're putting the string 'SelectedID' directly into your query. You'll need something like this in your VBA:
t = "SELECT DISTINCT s.entity_id, u.login_name, s.role " _
& "FROM staff s INNER JOIN user u ON s.entity_id=u.staff_id " _
& "WHERE u.staff_id IN (" & SelectedID & ")"
Rows.Count should be fully qualified and With ThisWorkbook.Worksheets("Sheet1") and fully qualifying will make your code read better.
Function getSelectedIDSQL() As String
Dim ID As Range, StaffID As Range
Dim SelectedID As String
With ThisWorkbook.Worksheets("Sheet1")
For Each ID In .Range("A2" & .Range("A" & .Rows.Count).End(xlUp))
If ID.Value > 0 Then SelectedID = SelectedID & "," & ID.Offset(, 1).Value
Next
End With
If Len(SelectedID) Then getSelectedIDSQL = Right(SelectedID, Len(SelectedID) - 1)
End Function
I have the problem that the combobox in access 2010 displays just 1249 values of the 1278. Is there a possibility to increase the max number of values in a combobox in access?
Here is a code sample:
If not rs.EOF Then
rs.MoveFirst
frm.FName.RowSource = ""
frm.FNameLux.RowSource = ""
Do Until rs.EOF
If rs![id] <> -1 And rs![id] <> -2 Then
If (rs!KID <> 2 And rs!KID <> 8) Then
If IsNull(rs![Name]) = False Then
frm.FName.AddItem rs![Name] & ";" & rs![id]
Debug.Print rs!Name 'The program writes all values in the combobox, but when I look in the form, I don't see all values
End If
End If
If (rs!KID = 2 Or rs!KID = 8) Then
If IsNull(rs![Name]) = False Then
frm.FNameLux.AddItem rs![Name] & ";" & rs![id]
End If
End If
End If
rs.MoveNext
i = i + 1
Loop
End If
rs is the recordset. Is there any idea how to solve it or what I have to do?
Apparently the RowSource property for RowSourceType = Value list is limited to 16bit integer length (2^15 = 32768) or a bit below.
Test code for a 2-column combobox:
Private Sub btValues_Click()
Dim i As Long
DoCmd.Hourglass True
Me.cboValues.RowSource = ""
For i = 1 To 5000
Me.cboValues.AddItem "Number " & Format(i, "0000") & ";" & i
Next i
DoCmd.Hourglass False
Debug.Print Len(Me.cboValues.RowSource)
End Sub
The combobox is filled up until "Number 1991", output is 32739.
So the problem is not the number of rows, but the total string length. If I shorten the text, it goes up to "Nr 2604" (32744 chars).
You'll have to use RowSourceType = Table/query to show all items.
Edit
Create queries as rowsource for the comboboxes. As far as I can see, there is nothing in your code that cannot be done in a WHERE clause.
E.g. for FName
SELECT Name, id
FROM yourTable
WHERE id <> -1 AND id <> -2
AND KID <> 2 AND KID <> 8
AND Name IS NOT NULL
If your VBA code could not be recreated in SQL, you'd have to insert the recordset rows you want into a temp table, and use this table as rowsource.
Background information: - There are nearly 7000 individuals and there is data about their performances in one, two or three tests.
Every individual has taken the 1st test (let's call it Test M). Some of those who have taken Test M have also taken Test I, and some of those who have taken Test I have also taken Test B.
For the first two tests (M and I), students can score grades I, II, or III. Depending on the grades they are awarded points -- 3 for grade I, 2 for II, 1 for III.
The last Test B is just a pass or a fail result with no grades. Those passing this test get 1 point, with no points for failure. (Well actually, grades are awarded, but all grades are given a common 1 point).
An amateur has entered data to represent these students and their grades in an Excel file. Problem is, this person has done the worst thing possible - he has developed his own notation and entered all test information in a single cell --- and made my life hell.
The file originally had two text columns, one for individual's id, and the second for test info, if one could call it that.
It's horrible, I know, and I am suffering. In the image, if you see "M-II-2 I-III-1" it means the person got grade II in Test M for 2 points and grade III in Test I for 1 point. Some have taken only one test, some two, and some three.
When the file came to me for processing and analyzing the performance of students, I sent it back with instructions to insert 3 additional columns with only the grades for the three tests. The file now looks as follows. Columns C and D represent grades I, II, and III using 1,2 and 3 respectively. Column C is for Test M, column D for Test I. Column E says BA (B Achieved!) if the individual has passed Test B.
Now that you have the above information, let's get to the problem. I don't trust this and want to check whether data in column B matches with data in columns C,D and E.
That is, I want to examine the string in column B and find out whether the figures in columns C,D and E are correct.
All help is really appreciated.
P.S. - I had exported this to MySQL via ODBC and that is why you are seeing those NULLs. I tried doing this in MySQL too, and really will accept a MySQL or an Excel solution, I don't have a preference.
Edit : - See file with sample data
To create a flat file from the original data:
Sub GetData()
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String, t As Variant, x As Variant
Dim i As Integer, j As Integer, k As Integer
''This is not the best way to refer to the workbook
''you want, but it is very conveient for notes
''It is probably best to use the name of the workbook.
strFile = ActiveWorkbook.FullName
''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * " _
& "FROM [Sheet1$] "
''Open the recordset for more processing
''Cursor Type: 3, adOpenStatic
''Lock Type: 3, adLockOptimistic
''Not everything can be done with every cursor type and
''lock type. See http://www.w3schools.com/ado/met_rs_open.asp
rs.Open strSQL, cn, 3, 3
''Pick a suitable empty worksheet for the results
With Worksheets("Sheet2")
''Fill headers into the first row of the worksheet
.Cells(1, 1) = "ID"
.Cells(1, 2) = "Exam"
.Cells(1, 3) = "Grade"
.Cells(1, 4) = "Points"
''Working with the recordset ...
''Counter for Fields/Columns in Recordset and worksheet
''Row one is used with titles, so ...
i = 1
Do While Not rs.EOF
''Store the ID to a string (if it is a long,
''change the type) ...
s = rs!ID
t = Split(rs!testinfo, " ")
For j = 0 To UBound(t)
''(Counter)
i = i + 1
.Cells(i, 1) = s
x = Split(t(j), "-")
For k = 0 To UBound(x)
If t(j) = "BA-1" Then
.Cells(i, 2) = "B"
.Cells(i, 3) = "A"
.Cells(i, 4) = 1
Else
.Cells(i, k + 2) = x(k)
End If
Next
Next
''Keep going
rs.MoveNext
Loop
''Finished with the sheet
End With
''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
To check the extra columns:
Sub CheckData()
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String, t As Variant, x As Variant
Dim i As Integer, j As Integer, k As Integer
Dim BAErr, MErr, IErr
strFile = ActiveWorkbook.FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * " _
& "FROM [Sheet1$] "
rs.Open strSQL, cn, 3, 3
Do While Not rs.EOF
t = Split(rs!testinfo, " ")
For j = 0 To UBound(t)
x = Split(t(j), "-")
Select Case x(0)
Case "BA"
If rs![test b] <> "BA" Then
BAErr = BAErr & "," & rs!ID
End If
Case "M"
If String(rs![test m], "I") <> x(1) Then
MErr = MErr & "," & rs!ID
End If
Case "I"
If String(rs![test i], "I") <> x(1) Then
IErr = IErr & "," & rs!ID
End If
End Select
Next
rs.MoveNext
Loop
''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
If BAErr <> "" Then
MsgBox Mid(BAErr, 2), , "B Errors"
End If
If MErr <> "" Then
MsgBox Mid(MErr, 2), , "M Errors"
End If
If IErr <> "" Then
MsgBox Mid(IErr, 2), , "I Errors"
End If
End Sub
Ok so a guy at work has a little access database he uses to keep track of things. He has this form that he uses that already queries what he needs and produces the results on a form and that is really all he needs.
One thing is that he has duplicates for every record that comes up with a different "Type" as a field "indentifier" (what I call it)...here is an example:
ID Name Price Type
1 Prodcut A $10 A1
1 Product A $10 A2
1 Product A $10 A3
2 Product B $12 A1
etc
naturally this is supposed to occur and he wants to see all the types but given it ends up being a mile long, he asked me if there was a way to concatenate the "types" so the following would be displayed:
ID Name Price Type
1 Prodcut A $10 A1, A2, A3
1 Product B $12 A1, A2, A3
1 Product C $14 A1, A2, A3
2 Product D $7 A1, A2, A3
...on the form. Can anyone please help me with this? Thanks!
OK, i found a function created in the VBA, which can be used in the query to retrieve the data for the form.
function is
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere As String, _
Optional strOrderBy As String, _
Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
'Purpose: Generate a concatenated string of related records.
'Return: String variant, or Null if no matches.
'Arguments: strField = name of field to get results from and concatenate.
' strTable = name of a table or query.
' strWhere = WHERE clause to choose the right values.
' strOrderBy = ORDER BY clause, for sorting the values.
' strSeparator = characters to use between the concatenated values.
'Notes: 1. Use square brackets around field/table names with spaces or odd characters.
' 2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
' 3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
' 4. Returning more than 255 characters to a recordset triggers this Access bug:
' http://allenbrowne.com/bug-16.html
Dim rs As DAO.Recordset 'Related records
Dim rsMV As DAO.Recordset 'Multi-valued field recordset
Dim strSql As String 'SQL statement
Dim strOut As String 'Output string to concatenate to.
Dim lngLen As Long 'Length of string.
Dim bIsMultiValue As Boolean 'Flag if strField is a multi-valued field.
'Initialize to Null
ConcatRelated = Null
'Build SQL string, and get the records.
strSql = "SELECT " & strField & " FROM " & strTable
If strWhere <> vbNullString Then
strSql = strSql & " WHERE " & strWhere
End If
If strOrderBy <> vbNullString Then
strSql = strSql & " ORDER BY " & strOrderBy
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)
'Determine if the requested field is multi-valued (Type is above 100.)
bIsMultiValue = (rs(0).Type > 100)
'Loop through the matching records
Do While Not rs.EOF
If bIsMultiValue Then
'For multi-valued field, loop through the values
Set rsMV = rs(0).Value
Do While Not rsMV.EOF
If Not IsNull(rsMV(0)) Then
strOut = strOut & rsMV(0) & strSeparator
End If
rsMV.MoveNext
Loop
Set rsMV = Nothing
ElseIf Not IsNull(rs(0)) Then
strOut = strOut & rs(0) & strSeparator
End If
rs.MoveNext
Loop
rs.Close
'Return the string without the trailing separator.
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
'Clean up
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
and is used in the query as
SELECT Table1.ID, Table1.ProductName, Table1.ProductPrice, ConcatRelated("Type","Table1","ID = " & [Table1]![ID] & " AND ProductName = """ & [Table1]![ProductName] & """ AND ProductPrice = " & [Table1]![ProductPrice]) AS Expr1
FROM Table1
GROUP BY Table1.ID, Table1.ProductName, Table1.ProductPrice, ConcatRelated("Type","Table1","ID = " & [Table1]![ID] & " AND ProductName = """ & [Table1]![ProductName] & """ AND ProductPrice = " & [Table1]![ProductPrice]);
I found an example (here) that seems to be exactly what you are looking for:
Concatenate Column Values from Multiple Rows into a Single Column with Access
From the above link:
The Problem
Coming up with a meaningful title for
this article was the hardest part. The
issue is one that I have seen a couple
times in the Access newsgroups, but it
is hard to describe without a specific
example. One post to
comp.databases.ms-access some years
ago put it this way:
I would like to combine a field's values from multiple records in a single field. For example:
Last First Code
------- --------- ----
Lesand Danny 1
Lesand Danny 2
Lesand Danny 3
Benedi Eric 7
Benedi Eric 14
Result should look like:
Last First Codes
------- --------- -----
Lesand Danny 1,2,3
Benedi Eric 7,14
Something on these lines may suit, but concatenating is usually not a good idea:
Function ConcatList(strSQL As String, strDelim, _
ParamArray NameList() As Variant)
''Reference: Microsoft DAO x.x Object Library
Dim db As Database
Dim rs As DAO.Recordset
Dim strList As String
Set db = CurrentDb
If strSQL <> "" Then
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF
strList = strList & strDelim & rs.Fields(0)
rs.MoveNext
Loop
strList = Mid(strList, Len(strDelim) + 1)
Else
strList = Join(NameList, strDelim)
End If
ConcatList = strList
End Function
FROM: http://wiki.lessthandot.com/index.php/Concatenate_a_List_into_a_Single_Field_(Column)
Why don't you try the "crosstab query" solution?