This question already has an answer here:
How to design a query to give names of each related field linked to each set of data
(1 answer)
Closed 2 years ago.
If I have the following table (shown in the image below), how can I write SQL code that would concatenate the grouped results?
For this example, I'd want to group by the LetterColumn and concatenate the NumberColumn
So the desired results would be:
Note: Same question has been posted not for SQL but for Power Query here:
PowerQuery: How can I concatenate grouped values?
Below is a small VBA procedure that does the grouping of the number column for a given letter (without the quotes, which would be trivial to add):
Public Function fGroupColumn(strLetter As String) As String
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsData As DAO.Recordset
Dim strSQL As String
Set db = DBEngine(0)(0)
strSQL = "SELECT NumberColumn FROM tblColumn WHERE LetterColumn='" & strLetter & "' ORDER BY NumberColumn ASC;"
Set rsData = db.OpenRecordset(strSQL)
If Not (rsData.BOF And rsData.EOF) Then
Do
fGroupColumn = fGroupColumn & rsData!NumberColumn & ","
rsData.MoveNext
Loop Until rsData.EOF
End If
If Right(fGroupColumn, 1) = "," Then fGroupColumn = Left(fGroupColumn, Len(fGroupColumn) - 1)
fExit:
On Error Resume Next
rsData.Close
Set rsData = Nothing
Set db = Nothing
Exit Function
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "fGroupColumn", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume fExit
End Function
You can then use this function within an Access query to get the result that you want.
Regards,
Related
I have a table that I need to format for use in a manual upload process. The table is thousands of rows so I need to use a repeatable process to quickly fix the way the data is given to me into what it needs to be. I have zero ability to control the way the data comes to me today. But, I have to format it to use it due to a system limitation. My current table is 4 columns, I need to output it as 3 columns. I have to group up by field names: "brand" and "promotion". Field name: "skus" I need to take and merge them into one continuous string by a single "brand" and "promotion" combination.
There are duplicate "promotion" by a given brand since they are created at a product level. But, the system they go into need to be "brand", "promotion", "skus".
Not really sure if I need to use VBA to do some of this inside Access. Or I can do this in two different queries.
You will need to use a bit of VBA to do this. The VBA will need to loop a recordset of data from the table that is filtered on brand and promotion and build up the sku string. Something like this perhaps:
Function fJoinData(strBrand As String, strPromotion As String) As String
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsData As DAO.Recordset
Dim strSQL As String
Set db = DBEngine(0)(0)
strSQL = "SELECT skus FROM Table1 " _
& " WHERE Brand='" & strBrand & "' " _
& " AND Promotion='" & strPromotion & "';"
Set rsData = db.OpenRecordset(strSQL)
If Not (rsData.BOF And rsData.EOF) Then
Do
fJoinData = fJoinData & ", " & rsData!skus
rsData.MoveNext
Loop Until rsData.EOF
End If
If Left(fJoinData, 2) = ", " Then fJoinData = Mid(fJoinData, 3)
fExit:
On Error Resume Next
rsData.Close
Set rsData = Nothing
Set db = Nothing
Exit Function
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "fJoinData", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume fExit
End Function
Rather than inserting into a table, I would suggest just creating a query which can then be exported:
SELECT DISTINCT
T.Brand,
T.Promotion,
fJoinData(T.Brand,T.Promotion) AS skus
FROM Table1 AS T
Regards,
I am trying to use this code to calculate median from my query which has these criteria:
<[Form]![testForm2]![crit1] And >[Form]![testForm2]![crit2] and <[Form]![testForm2]![Age1] And >[Form]![testForm2]![Age2]
without these criteria function works well and gives for every task median based on "MP", however when I put in there my criteria I receive error:
error - Too few parameters. Expected 4 and then it says 'Object Variable or With block not set'
my input: DMedian("MP";"testForm2";"[TASK]= '" & [TASK] & "'")
*even when the Form is open it end up with the error.
*I probably need to find a different way to filter this query from the form, but I don't know how
Public Function DMedian(FieldName As String, _
TableName As String, _
Optional Criteria As Variant) As Variant
' Created by Roger J. Carlson
' http://www.rogersaccesslibrary.com
' Terms of use: You may use this function in any application, but
' it must include this notice.
'Returns the median of a given field in a given table.
'Returns -1 if no recordset is created
' You use this function much like the built-in Domain functions
' (DLookUp, DMax, and so on). That is, you must provide the
' 1) field name, 2) table name, and 3) a 'Where' Criteria.
' When used in an aggregate query, you MUST add each field
' in the GROUP BY clause into the into the Where Criteria
' of this function.
' See Help for more on Domain Aggregate functions.
On Error GoTo Err_Median
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim RowCount As Long
Dim LowMedian As Double, HighMedian As Double
'Open a recordset on the table.
Set db = CurrentDb
strSQL = "SELECT " & FieldName & " FROM " & TableName
If Not IsMissing(Criteria) Then
strSQL = strSQL & " WHERE " & Criteria & " ORDER BY " & FieldName
Else
strSQL = strSQL & " ORDER BY " & FieldName
End If
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
'Find the number of rows in the table.
rs.MoveLast
RowCount = rs.RecordCount
rs.MoveFirst
'Determine Even or Odd
If RowCount Mod 2 = 0 Then
'There is an even number of records. Determine the low and high
'values in the middle and average them.
rs.Move Int(RowCount / 2) - 1
LowMedian = rs(FieldName)
rs.Move 1
HighMedian = rs(FieldName)
'Return Median
DMedian = (LowMedian + HighMedian) / 2
Else
'There is an odd number of records. Return the value exactly in
'the middle.
rs.Move Int(RowCount / 2)
'Return Median
DMedian = rs(FieldName)
End If
Exit_Median:
'close recordset
rs.Close
Exit Function
Err_Median:
If Err.number = 3075 Then
DMedian = 0
Resume Exit_Median
ElseIf Err.number = 3021 Then
'EOF or BOF ie no recordset created
DMedian = -1
Resume Exit_Median
Else
MsgBox Err.Description
Resume Exit_Median
End If
End Function
The parameter separation character is comma and you are using a semi-colon
CHANGE:
DMedian("MP";"testForm2";"[TASK]= '" & [TASK] & "'")
TO:
DMedian("MP", "testForm2", "[TASK]= '" & [TASK] & "'")
Solution was to refer the text boxes in SQL declaration, Thank you guys
like this:
HAVING (((Data.[REV]< " & Me.crit1 & ") And (Data.[REV])>" & Me.crit2 & ") AND ((Reg.Age)<" & Me.Age1 & " And (Reg.Age)>" & Me.Age2 & " " & SQLcritComplete & "));"
NOT like this:
"HAVING (((Data.[REV]<[Form]![testForm2]![crit1]) And (Data.[REV])>[testForm2]![crit2]) AND ((Reg.Age)<[Form]![testForm2]![Age1] And (Reg.Age)>[Form]![testForm2]![Age2] & SQLcritComplete & "));"
I am creating a schedule calendar which has been working great, but I want to adjust the SQL so that it only shows when the next job has to be done. I was thinking the best way to achieve this would be via the MAX() function, however when i run the code Access doesn't seem to like it.
Public Sub LoadArray()
'This sub loads an array with the relevant variables from a query
Dim db As Database
Dim rs As Recordset
Dim rsFiltered As Recordset
Dim strQuery As String
Dim i As Integer
Dim Text23 As Integer
On Error GoTo ErrorHandler
Text23 = Forms.frmPreventativeMenu.Form.CompanyName.Value
strQuery = "SELECT tblWMYReports.Company, tblWMYReports.Machine, MAX(tblWMYReports.NextDate), tblWMYReports.WMY " _
& "FROM tblWMYReports " _
& "WHERE (((tblWMYReports.Company)= " & Text23 & " ));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strQuery)
With rs
If Not rs.BOF And Not rs.EOF Then
'Ensures the recordset contains records
For i = 0 To UBound(MyArray)
'Will loop through the array and use dates to filter down the query
'It firsts checks that the second column has true for its visible property
If MyArray(i, 1) = True Then
.Filter = "[NextDate]=" & MyArray(i, 0)
'To filter you must open a secondary recordset and
'Use that as the basis for a query
'This makes sense as you are building a query on a query
Set rsFiltered = .OpenRecordset
If Not rsFiltered.BOF And Not rsFiltered.EOF Then
'If the recordset is not empty then you are able
'to extract the text from the values provided
Do While Not rsFiltered.EOF = True
MyArray(i, 2) = MyArray(i, 2) & vbNewLine & DLookup("MachineName", "tblMachine", "MachineID=" & rsFiltered!Machine)
MyArray(i, 2) = MyArray(i, 2) & " - " & DLookup("WMY", "tblWMY", "ID=" & rsFiltered!WMY)
rsFiltered.MoveNext
Loop
End If
End If
Next i
End If
.Close
End With
ExitSub:
Set db = Nothing
Set rs = Nothing
Exit Sub
ErrorHandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
You are going to aggregate one column with an aggregate function like Sum(), Max(), Count() or similar, then every other column that isn't being aggregated must show up in the SQL's GROUP BY clause:
strQuery = "SELECT tblWMYReports.Company, tblWMYReports.Machine, MAX(tblWMYReports.NextDate), tblWMYReports.WMY " _
& "FROM tblWMYReports " _
& "WHERE (((tblWMYReports.Company)= " & Text23 & " )) " _
& "GROUP BY tblWMYReports.Company, tblWMYReports.Machine, tblWMYReports.WMY;"
I can't guarantee that is going to do what you want it to, since I'm not familiar with your data, code, or application, but it should get you through the error.
You must use a properly formatted string expression for the date value:
.Filter = "[NextDate] = #" & Format(MyArray(i, 0), "yyyy\/mm\/dd") & "#"
I'm having a problem getting a recordset to run from a query I created in an MS Access 2010 database. here is t he code I want to run:
Private Sub Command192_Click()
Dim recs As String
Dim param As Integer
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("UnitRec_Qry", dbOpenDynaset)
With rs
.MoveLast
.MoveFirst
While Not .EOF
recs = recs & vbNewLine & !Spara & " - " & !Rec
.MoveNext
Wend
End With
MsgBox (recs)
End Sub
What this should output is a message box with a number of records from the query in a list. I do this so I can gather this and a number of other records into a text file for copying and pasting into a separate system. At the moment, I'm running this code so I can place it all into a string variable.
My problem is that I'm getting the dreaded "Too Few parameters expected 1" error.
The query works, I've saved it into the database and tested it and I get the expected results.
I tried running the recordset with SQL:
Set rs = CurrentDb.OpenRecordset("SELECT UnitRecommend_tbl.URecID, UnitRecommend_tbl.Spara," _
& " UnitRecommend_tbl.Rec, UnitRecommend_tbl.SvyID" _
& " FROM UnitRecommend_tbl" _
& " WHERE ((UnitRecommend_tbl.SvyID) = [Forms]![SurveyRegister_frm]![SurveyID])" _
& " ORDER BY UnitRecommend_tbl.Spara;", dbOpenDynaset)
I get the same error
I ran it again but removed the "WHERE" statement and the code ran just fine, but gave me every record in the table. Not what I wanted.
So, the fields are OK because the data runs. When I debug the text the parameter in the SQL does show up as the right parameter, in this case, the number 4 which is an integer.
So I'm at a loss here, I've searched through the other posts here and I have tried these possible solutions (unless I missed something).
I also tried using dbopensnapshot as well, still no joy. Wondering if I'm using the right code here now.
Any help would be great.
Cheers
A parameter like [Forms]![SurveyRegister_frm]![SurveyID] doesn't get evaluated automatically if you open a recordset in VBA.
Use this function:
Public Sub Eval_Params(QD As DAO.QueryDef)
On Error GoTo Eval_Params_Err
Dim par As DAO.Parameter
For Each par In QD.Parameters
' This is the key line: Eval "evaluates" the form field and gets the value
par.Value = Eval(par.Name)
Next par
Eval_Params_Exit:
On Error Resume Next
Exit Sub
Eval_Params_Err:
MsgBox Err.Description, vbExclamation, "Runtime-Error " & Err.Number & " in Eval_Params"
Resume Eval_Params_Exit
End Sub
with a QueryDef object like this:
Dim QD As QueryDef
Dim RS As Recordset
Set QD = DB.QueryDefs("UnitRec_Qry")
Call EVal_Params(QD)
Set RS = QD.OpenRecordset(dbOpenDynaset)
Alternatively, you can run it with SQL in the VBA code by moving the parameter outside of the SQL string:
Set rs = CurrentDb.OpenRecordset("SELECT UnitRecommend_tbl.URecID, UnitRecommend_tbl.Spara," _
& " UnitRecommend_tbl.Rec, UnitRecommend_tbl.SvyID" _
& " FROM UnitRecommend_tbl" _
& " WHERE ((UnitRecommend_tbl.SvyID) = " & [Forms]![SurveyRegister_frm]![SurveyID] & ")" & _
& " ORDER BY UnitRecommend_tbl.Spara;", dbOpenDynaset)
I want to log web site visits' IP, datetime, client and refferer data to access database but I'm planning to log every days log data in separate tables in example logs for 06.06.2010 will be logged in 2010_06_06 named table. When date is changed I'll create a table named 2010_06_07. But the problem is if this table is already created.
Any suggestions how to check if table exists in Access?
You can use the hidden system table MSysObjects to check if a table exists:
If Not IsNull(DlookUp("Name","MSysObjects","Name='TableName'")) Then
'Table Exists
However, I agree that it is a very bad idea to create a new table every day.
EDIT: I should add that tables have a type 1, 4 or 6 and it is possible for other objects of a different type to have the same name as a table, so it would be better to say:
If Not IsNull(DlookUp("Name","MSysObjects","Name='TableName' And Type In (1,4,6)")) Then
'Table Exists
However, it is not possible to create a table with the same name as a query, so if you need a look up to test for a name, it may be best to add 5, that is query, to the Type list.
Here's another solution, will be a bit faster than looping over all of the tables.
Public Function doesTableExist(strTableName As String) As Boolean
Dim db As DAO.Database
Dim td As DAO.TableDef
Set db = CurrentDb
On Error Resume Next
Set td = db.TableDefs(strTableName)
doesTableExist = (Err.Number = 0)
Err.Clear
End Function
I tested various methods for finding out if a table exists several years ago. Here is the code for all of them as I implemented, including my simple test routine.
Public Function TableExists(strTableName As String, Optional ysnRefresh As Boolean, Optional db As DAO.Database) As Boolean
' Originally Based on Tony Toews function in TempTables.MDB, http://www.granite.ab.ca/access/temptables.htm
' Based on testing, when passed an existing database variable, this is the fastest
On Error GoTo errHandler
Dim tdf As DAO.TableDef
If db Is Nothing Then Set db = CurrentDb()
If ysnRefresh Then db.TableDefs.Refresh
Set tdf = db(strTableName)
TableExists = True
exitRoutine:
Set tdf = Nothing
Exit Function
errHandler:
Select Case Err.Number
Case 3265
TableExists = False
Case Else
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Error in mdlBackup.TableExists()"
End Select
Resume exitRoutine
End Function
Public Function TableExists2(strTableName As String, Optional ysnRefresh As Boolean, Optional db As DAO.Database) As Boolean
On Error GoTo errHandler
Dim bolCleanupDB As Boolean
Dim tdf As DAO.TableDef
If db Is Nothing Then
Set db = CurrentDb()
bolCleanupDB = True
End If
If ysnRefresh Then db.TableDefs.Refresh
For Each tdf In db.TableDefs
If tdf.name = strTableName Then
TableExists2 = True
Exit For
End If
Next tdf
exitRoutine:
Set tdf = Nothing
If bolCleanupDB Then
Set db = Nothing
End If
Exit Function
errHandler:
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Error in mdlBackup.TableExists1()"
Resume exitRoutine
End Function
Public Function TableExists3(strTableName As String, _
Optional db As DAO.Database) As Boolean
' Based on testing, when NOT passed an existing database variable, this is the fastest
On Error GoTo errHandler
Dim strSQL As String
Dim rs As DAO.Recordset
If db Is Nothing Then Set db = CurrentDb()
strSQL = "SELECT MSysObjects.Name FROM MSysObjects "
strSQL = strSQL & "WHERE MSysObjects.Name=" & Chr(34) & strTableName & Chr(34)
strSQL = strSQL & " AND MSysObjects.Type=6;"
Set rs = db.OpenRecordset(strSQL)
TableExists3 = (rs.RecordCount <> 0)
exitRoutine:
If Not (rs Is Nothing) Then
rs.Close
Set rs = Nothing
End If
Exit Function
errHandler:
MsgBox Err.Number & ": " & Err.Description, vbCritical, _
"Error in TableExists1()"
Resume exitRoutine
End Function
Public Sub TestTableExists(strTableName As String, intLoopCount As Integer)
Dim dteStart As Date
Dim i As Integer
Dim bolResults As Boolean
dteStart = Now()
For i = 0 To intLoopCount
bolResults = TableExists(strTableName, , CurrentDB())
Next i
Debug.Print "TableExists (" & intLoopCount & "): " & Format(Now() - dteStart, "nn:ss")
dteStart = Now()
For i = 0 To intLoopCount
bolResults = TableExists2(strTableName, , CurrentDB())
Next i
Debug.Print "TableExists2 (" & intLoopCount & "): " & Format(Now() - dteStart, "nn:ss")
dteStart = Now()
For i = 0 To intLoopCount
bolResults = TableExists3(strTableName, CurrentDB())
Next i
Debug.Print "TableExists3 (" & intLoopCount & "): " & Format(Now() - dteStart, "nn:ss")
End Sub
I have found querying system tables or tabledefs to be unreliable and introduce unpredictable behaviour in scripts where tables get regularly created and dropped.
Based on my results, my hypothesis is that these tables aren't necessarily updated at the exact instant a CREATE or DROP is executed, or that concurrency issues are preventing me from getting an accurate result.
I've found the following method to be more reliable:
Public Function TableExists(theDatabase As Access.Application, _
tableName As String) As Boolean
' Presume that table does not exist.
TableExists = False
' Define iterator to query the object model.
Dim iTable As Integer
' Loop through object catalogue and compare with search term.
For iTable = 0 To theDatabase.CurrentData.AllTables.Count - 1
If theDatabase.CurrentData.AllTables(iTable).Name = tableName Then
TableExists = True
Exit Function
End If
Next iTable
End Function
There should be no runtime issue iterating unless there is an staggeringly enormous collection of tables.
This question is quite old but I found that no answer is satisfying, because:
they do not handle the case of "bad" linked tables, where the linked table points to a non existing db or table.
since linked tables are potentially huge, we must be able to check them with a fast query.
So here is my simple but more complete solution:
Function isTableOk(tblName As String) As Boolean
'works with local or linked tables
Dim db As DAO.Database, rs As DAO.Recordset
Dim sSql As String
sSql = "SELECT TOP 1 ""xxx"" AS Expr1 FROM [" & tblName & "]"
On Error Resume Next
Err.Clear
Set db = CurrentDb
Set rs = db.OpenRecordset(sSql)
isTableOk = (Err.Number = 0)
rs.Close
End Function
You can even check table in an external Access db with this version:
Function isTableOk(tblName As String, Optional dbName As String) As Boolean
'works with local or linked tables, or even tables in external db (if dbName is provided)
Dim db As DAO.Database, rs As DAO.Recordset
Dim sSql As String
Set db = CurrentDb
sSql = "SELECT TOP 1 'xxx' AS Expr1 FROM [" & tblName & "]"
If Len(dbName) > 0 Then 'external db
sSql = sSql & " IN '" & dbName & "'"
End If
Err.Clear
On Error Resume Next
Set rs = db.OpenRecordset(sSql)
isTableOk = (Err.Number = 0)
rs.Close
End Function