I made the mistake of structuring some Access tables ineffectively as I was developing a database to store data for my company.
The data pushes and pulls from various models, so I need to restructure the old "labor" tables (each proposal has a labor table) so that any data can be retrieved in the future.
I'm brand new to SQL. I've tried doing this a few different ways (APPEND, ALTER...ADD COLUMN, and others). I think that SELECT...INTO is the way to go at this point, but I still can't get it quite right.
In the old table structure, the first field is "Period." All of the records reappear once for every period. The LCAT, Company, and Salary fields are exactly the same for each period. The only values that change from period to period are the 2 right columns.
I need to restructure these by copying the hours and DLRate values for each period after the 1st into new columns (and rename the Hours/DLRates columns. I've included what I have so far.
Thanks in advance!
| Period LCAT Company Salary Hours DLRate |
|-----------------------------------------|
| 1 LCAT1 Comp1 77000 1723 $37.02|
| 1 LCAT2 Comp1 81000 1723 $38.94|
| 1 LCAT3 Comp2 81000 1723 $50.00|
| 2 LCAT1 Comp1 77000 1800 $38.02|
| 2 LCAT2 Comp1 81000 1800 $39.94|
| 2 LCAT3 Comp2 81000 1800 $51.00|
Option Compare Database
Option Explicit
Sub RedoTables()
Dim sTbl As String
Dim sSQL As String
Dim sTemp As String
Dim intA As Long, intB As Long
Dim arrCols() As String: arrCols() = Split("Hours,DLRate", ",")
sTbl = "Labor"
For intB = 1 To 2
`enter code here`For intA = LBound(arrCols) To UBound(arrCols)
sTemp = "(SELECT " & arrCols(intA) & " FROM [" & sTbl & "] " _
& "WHERE Period = " & intB & ") " _
& "AS P" & intB & "_" & arrCols(intA)
Debug.Print sTemp
sSQL = sSQL & sTemp
If intA < UBound(arrCols) Or intB < 1 Then sSQL = sSQL & ", "
Next
Next
sSQL = "SELECT" & sSQL & " " _
& "INTO [" & sTbl & "test] " _
& "FROM [" & sTbl & "]; "
DoCmd.RunSQL sSQL
End Sub
When I execute the SQL, I am getting an error that states "at most one record can be returned by this subquery"....
Related
Apologies for the vague title, but here is my issue. I have a form that has several select lists and associated text boxes. Basically the way it works is if you select a name from the first list, an AfterUpdate event is triggered to query the DB to see if the Eng_ID and Person_ID already exist in the table. If so, then delete that row then insert the updated row. If there is not any records, then just insert the data. The problem is that when I click a name in the first list, then move to the second list, what's happening is that the the Person_ID of the first list is used for the DLookup query, then it delets the record, then inserts the record of the new person I selected in a different listbox. The code is below: Thanks in advance
' Add/Remove Participant 1
Private Sub lstPar1_AfterUpdate()
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With Me.lstPar1
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
If .Selected(n) = False Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
CurrentDb.Execute strSQL, dbFailOnError
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 1 & ",'" & Me.txtParRole1.Value & "' )"
CurrentDb.Execute strSQL, dbFailOnError
End If
End If
Next n
End With
End Sub
' Add/Remove Participant 2
Private Sub lstPar2_AfterUpdate()
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With Me.lstPar2
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
If .Selected(n) = False Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
CurrentDb.Execute strSQL, dbFailOnError
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role) " & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 2 & ",'" & Me.txtParRole2.Value & "' )"
CurrentDb.Execute strSQL, dbFailOnError
End If
End If
Next n
End With
End Sub
Using this image, if I select Daniel and enter his role, then the eng_ID, Person_ID, ParticipantNumber and Role are entered into the database as 130, 118, 1, Collaborator.
If I select Kristin, it deletes Daniel becuause it's still using Person_ID of 118 instead of hers which is 134, and since there is a corresponding record, it delets Daniel then adds Kristin.
I don't have Access to test this with, but it seems like you need to separate Participant1 records from Participant2 records when you perform your DLookups.
Also you can generalize your code by pulling the common parts into a separate sub.
Private Sub lstPar1_AfterUpdate()
CheckParticipant Me.lstPar1, 1, Me.txtParRole1.Value
End Sub
Private Sub lstPar2_AfterUpdate()
CheckParticipant Me.lstPar2, 2, Me.txtParRole2.Value
End Sub
Sub CheckParticipant(objList As Object, participantNum As Long, role As String)
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With objList
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n) & _
" And ParticipantNumber=" & participantNum
strSQL = ""
If Not .Selected(n) Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & _
" VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & participantNum & _
",'" & role & "' )"
End If
End If
If Len(strSQL) > 0 Then CurrentDb.Execute strSQL, dbFailOnError
Next n
End With
End Sub
Original code link: MS Access - Convert rows values into columns values
I have a follow up to a question where the answer didn't completely resolve, but got super close. It was asked at the original code link above. It's the single page on the net that actually addresses the issue of transposing multiple values in a one-to-many relationship set of columns to a single row for each related value in a dynamic manner specifically using VBA. Variations of this question have been asked about a dozen times on this site and literally none of the answers goes as far as Vlado did (the user that answered), which is what's necessary to resolve this problem.
I took what Vlado posted in that link, adjusted it for my needs, did some basic cleanup, worked through all the trouble-shooting and syntax problems (even removed a variable declared that wasn't used: f As Variant), and found that it works almost all the way. It generates the table with values for the first two columns correctly, iterates the correct number of variable count columns with headers correctly, but fails to populate the values within the cells for each of the related "many-values". So close!
In order to get it to that point, I have to comment-out db.Execute updateSql portion of the Transpose Function; 3rd to last row from the end. If I don't comment that out, it still generates the table, but it throws a Run-Time Error 3144 (Syntax error in UPDATE statement) and only creates the first row and all the correct columns with correct headers (but still no valid values inside the cells). Below is Vlado's code from the link above, but adjusted for my field name needs, and to set variables at the beginning of each of the two Functions defined. The second Function definitely works correctly.
Public Function Transpose()
Dim DestinationCount As Integer, i As Integer
Dim sql As String, insSql As String, fieldsSql As String, updateSql As String, updateSql2 As String
Dim db As DAO.Database, rs As DAO.Recordset, grp As DAO.Recordset
Dim tempTable As String, myTable As String
Dim Var1 As String, Var2 As String, Var3 As String, Var4 As String
tempTable = "Transposed" 'Value for Table to be created with results
myTable = "ConvergeCombined" 'Value for Table or Query Source with Rows and Columns to Transpose
Var1 = "Source" 'Value for Main Rows
Var2 = "Thru" 'Value for Additional Rows
Var3 = "Destination" 'Value for Columns (Convert from Rows to Columns)
Var4 = "Dest" 'Value for Column Name Prefixes
DestinationCount = GetMaxDestination
Set db = CurrentDb()
If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tempTable & "'")) Then
DoCmd.DeleteObject acTable, tempTable
End If
fieldsSql = ""
sql = "CREATE TABLE " & tempTable & " (" & Var1 & " CHAR," & Var2 & " CHAR "
For i = 1 To DestinationCount
fieldsSql = fieldsSql & ", " & Var4 & "" & i & " INTEGER"
Next i
sql = sql & fieldsSql & ")"
db.Execute (sql)
insSql = "INSERT INTO " & tempTable & " (" & Var1 & ", " & Var2 & ") VALUES ("
Set grp = db.OpenRecordset("SELECT DISTINCT " & Var1 & ", " & Var2 & " FROM " & myTable & " GROUP BY " & Var1 & ", " & Var2 & "")
grp.MoveFirst
Do While Not grp.EOF
sql = "'" & grp(0) & "','" & grp(1) & "')"
db.Execute insSql & sql
Set rs = db.OpenRecordset("SELECT * FROM " & myTable & " WHERE " & Var1 & " = '" & grp(0) & "' AND " & Var2 & " = '" & grp(1) & "'")
updateSql = "UPDATE " & tempTable & " SET "
updateSql2 = ""
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
updateSql2 = updateSql2 & "" & Var3 & "" & i & " = " & rs(2) & ", " ' <------- MADE CHANGE FROM (3) to (2)
rs.MoveNext
Loop
updateSql = updateSql & Left(updateSql2, Len(updateSql2) - 1) & " WHERE " & Var1 & " = '" & grp(0) & "' AND " & Var2 & " = '" & grp(1) & "'"
db.Execute updateSql ' <-- This is the point of failure
grp.MoveNext
Loop
End Function
Public Function GetMaxDestination()
Dim rst As DAO.Recordset, strSQL As String
myTable = "ConvergeCombined" 'Value for Table or Query Source with Rows and Columns to Transpose
Var1 = "Source" 'Value for Main Rows
Var2 = "Thru" 'Value for Additional Rows
Var3 = "Destination" 'Value for Columns (Convert from Rows to Columns)
strSQL = "SELECT MAX(CountOfDestination) FROM (SELECT Count(" & Var3 & ") AS CountOfDestination FROM " & myTable & " GROUP BY " & Var1 & ", " & Var2 & ")"
Set rst = CurrentDb.OpenRecordset(strSQL)
GetMaxDestination = rst(0)
rst.Close
Set rst = Nothing
End Function
Sample Table:
Sample Data:
Add a Debug.Print updateSql before that Execute line and will see improper syntax in SQL statement. Need to trim trailing comma from updateSql2 string. Code is appending a comma and space but only trims 1 character. Either eliminate space from the concatenation or trim 2 characters.
Left(updateSql2, Len(updateSql2) - 2)
Concatenation for updateSql2 is using Var3 instead of Var4.
Source field is a number type in ConvergeCombined and this triggers a 'type mismatch' error in SELECT statement to open recordset because of apostrophe delimiters Var1 & " = '" & grp(0) & "' - remove them from two SQL statements.
Also, Source value is saved to a text field in Transposed, make it INTEGER instead of CHAR in the CREATE TABLE action.
So with the help of a friend I figured it out. It turns out I needed two Functions because the one-to-many relationships go both directions in my case. I explain below what needs to happen in comments for this to work. Essentially I went with the second comment under the question I posed (pre-defining field names in static tables because there is a limited number of fields that any person will need - it can't exceed 256 fields anyway, but it isn't always practical to use more than a dozen or so fields - this way allows for both and at the same time to simplify the code significantly).
This solution actually works - but it's dependent on having tables (or queries in my situation) labeled ConvergeSend and ConvergeReceive. Also, it's important to note that the instances where the Destination is single and the Source is plural, the table or query (ConvergeSend/ConvergeReceive) must have the Destination value as a column TO THE LEFT of the iterated Source columns. This is also true (but reverse naming convention) for the other table/query (the Source column must be TO THE LEFT of the iterated Destination columns).
' For this code to work, create a table named "TransposedSend" with 8 columns: Source, Destination1, Destination2,...Destination7; OR however many you need
' Save the table, Edit it, change all field values to Number and remove the 0 as Default Value at the bottom
' Not changing the field values to Number causes the Insert Into function to append trailing spaces for no apparent reason
Public Function TransposeSend()
Dim i As Integer
Dim rs As DAO.Recordset, grp As DAO.Recordset
CurrentDb.Execute "DELETE * FROM TransposedSend", dbFailOnError
CurrentDb.Execute "INSERT INTO TransposedSend (Source) SELECT DISTINCT Source FROM ConvergeSend GROUP BY Source", dbFailOnError
Set grp = CurrentDb.OpenRecordset("SELECT DISTINCT Source FROM ConvergeSend GROUP BY Source")
grp.MoveFirst
Do While Not grp.EOF
Set rs = CurrentDb.OpenRecordset("SELECT Source, Destination, [Destination App Name] FROM ConvergeSend WHERE Source = " & grp(0))
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
CurrentDb.Execute "UPDATE TransposedSend SET Destination" & i & " = '" & rs(1) & "', [Destination" & i & " App Name] = '" & rs(2) & "'" & " WHERE Source = " & grp(0)
rs.MoveNext
Loop
grp.MoveNext
Loop
End Function
' For this code to work, create a table named "TransposedReceive" with 8 columns: Destination, Source1, Source2,...Source7; OR however many you need
' Save the table, Edit it, change all field values to Number and remove the 0 as Default Value at the bottom
' Not changing the field values to Number causes the Insert Into function to append trailing spaces for no apparent reason
Public Function TransposeReceive()
Dim i As Integer
Dim rs As DAO.Recordset, grp As DAO.Recordset
CurrentDb.Execute "DELETE * FROM TransposedReceive", dbFailOnError
CurrentDb.Execute "INSERT INTO TransposedReceive (Destination) SELECT DISTINCT Destination FROM ConvergeReceive GROUP BY Destination", dbFailOnError
Set grp = CurrentDb.OpenRecordset("SELECT DISTINCT Destination FROM ConvergeReceive GROUP BY Destination")
grp.MoveFirst
Do While Not grp.EOF
Set rs = CurrentDb.OpenRecordset("SELECT Destination, Source, [Source App Name] FROM ConvergeReceive WHERE Destination = " & grp(0))
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
CurrentDb.Execute "UPDATE TransposedReceive SET Source" & i & " = '" & rs(1) & "', [Source" & i & " App Name] = '" & rs(2) & "'" & " WHERE Destination = " & grp(0)
rs.MoveNext
Loop
grp.MoveNext
Loop
End Function
Good morning,
Here is the situation: Have a column of credit card transactions that lists employee names and charge amounts a.k.a debits. In the same column it also lists employee names with an equal negative amount which shows a credit to the account.
What I am trying to do is to find the employee name and charge amount. Then cycle through the list and find the corresponding negative amount.
For example:
John Doe, $100
Jane Doe, $200
Sam Smith, $300
John Doe, -$100
When you run this module your results should return the names of Jane Doe and Sam Smith because only the records for John Doe had both a positive and negative value.
I have gotten very close to an answer but the solution falls apart when there are duplicate values.
For example:
John Doe, $100
John Doe, $100
John Doe, -$100
In this solution the result should be John Doe, $100
So far I have tried with Access, VBA, and SQL but have not come up with an answer.
For the solution, I don't really care if it means adding another object such as a table or a query to perform the comparison part. In the end I need to see a list of matched and unmatched employee names and values.
Additionally, I thought about adding on a column to my table that has a Boolean logic to show the two "matched" records as this will be a database and we don't necessarily want to delete the matched rows from the table master.
Thanks in advance!
You could add a Boolean field Cleared, and then run a simple loop in VBA to mark those set of record that match as cleared:
Public Function ClearTransactions()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim Criteria As String
Set db = CurrentDb
Set rs1 = db.OpenRecordset("Select * From Transaction Where Value > 0 And Cleared = False Order By Id")
Set rs2 = db.OpenRecordset("Select * From Transaction Where Value < 0 And Cleared = False Order By Id")
While Not rs1.EOF
Criteria = _
"Id > " & rs1!Id.Value & " And " & _
"EmpName = '" & rs1!EmpName.Value & "' And " & _
"Value = " & Str(-rs1!Value.Value) & " And " & _
"Cleared = False"
rs2.FindFirst Criteria
If rs2.NoMatch = False Then
rs1.Edit
rs1!Cleared.Value = True
rs1.Update
rs2.Edit
rs2!Cleared.Value = True
rs2.Update
End If
rs1.MoveNext
Wend
rs2.Close
rs1.Close
Set rs2 = Nothing
Set rs1 = Nothing
Set db = Nothing
End Function
I assume your table has a Primary Key (I'll call it TransactionID and assume it's Long Integer - adjust following code as necessary), in which case I would create a tblMatches with columns DebitID and CreditID to record pairs of entries that tie up. To populate this table:
Dim rsDebits As Recordset
Dim lngCreditID as Long
Set rsDebits = CurrentDb.OpenRecordset ("SELECT * FROM tblTransactions " & _
"WHERE ChargeAmount > 0 And TransactionID Not In " & _
"(SELECT DebitID From tblMatches)")
Do While Not rsDebits.EOF
lngCreditID = Nz(DMin("TransactionID", "tblTransactions", _
"EmpName = '" & rsDebits!EmpName & "' And " _
"ChargeAmount = " & -rsDebits!ChargeAmount & " And " _
"TransactionID Not In (SELECT CreditID From tblMatches)"), 0)
If lngCreditID > 0 Then
CurrentDb.Execute "INSERT INTO tblMatches (DebitID, CreditID) " & _
"VALUES (" & rsDebits!TransactionID & ", " & lngCreditID & ")"
End If
rsDebits.MoveNext
Loop
Set rsDebit = Nothing
You can now write a query joining this tblMatches to tblTransactions (twice, once joined ON tblTransactions.TransactionID = tblMatches.DebitID and the other one ON tblTransactions.TransactionID = tblMatches.CreditID) to show all the various entries that match up. To get a list of unmatched entries you'll need to design a query along the lines of
SELECT * FROM tblTransactions
WHERE TransactionID Not In (Select DebitID From tblMatches)
And TransactionID Not In (Select CreditID From tblMatches)
I am working with manually created empty copy of table Products, which I named Products_Backup. What I want to do is to insert every other row from "Spices" category of products into this empty Products_Backup table, since there would be only 6 rows from total of 12 rows, that are in Products table under "Spices" category. The problem is that I don't know how to do that. I tried to use MOD operator for newly created ProductID, but my mentor told me that it is not a proper solution, since he could easily change this ProductID's value and I would get odd rows instead of even.
Private Sub CommandButton0_Click()
Dim db As Database, rst As Recordset
Dim I As Integer, s, s1 As String
Set db = CurrentDb
s = "SELECT Products.* FROM Products WHERE (((Products.CategoryNumber)=2));" ' This value is for Spices
Set rst = db.OpenRecordset(s)
I = 1
While Not rst.EOF
s1 = "INSERT INTO Products_Backup (ProductName, ProductID, CategoryNumber, OrderedUnits) VALUES ('" & rst!ProductName & "', " & I & " , '" & rst!CategoryNumber & "', '" & rst!OrderedUnits & "');"
MsgBox ("Record inserted")
db.Execute s1
I = I + 1
rst.MoveNext
If I Mod 10 = 0 Then
MsgBox ("Inserted " & I & ".record")
End If
Wend
rst.Close
db.Close
End Sub
So with this I can insert all 12 records into Products_Backup, with MsgBox telling me when 10th record was inserted.
But I still have no idea what to do to insert every other row into Products_Backup to get 6 records.
Dim booEveryOther as Boolean
booEveryOther = False
While Not rst.EOF
If booEveryOther Then
s1 = "INSERT INTO ...
End If
booEveryOther = Not booEveryOther
Just use a Boolean value that is set to Not itself with every new record.
i think this should do it better
While Not rst.EOF
s1 = " INSERT INTO Products_Backup (ProductName, ProductID, CategoryNumber, OrderedUnits) " & _
" VALUES ('" & rst!ProductName & "', " & I & " , '" & rst!CategoryNumber & "', '" & rst!OrderedUnits & "');"
db.Execute s1
If I Mod 10 = 0 Then
MsgBox ("Inserted " & I & ".record")
Else
MsgBox ("Record inserted")
End If
I = I + 1
rst.MoveNext
Wend
Need your help bring such a way the below format.. i am pretty must confused to bring the format dynamically every month,Because every month the column name has to be swap between MO or Adj_M0
If you see my example
When you see the above format which i need for every month.
Ex: refer Ouput - Jan (Column Name) will swap compare to Ouput - Feb
Similar like it will swap the column on every month , so can you please guide me how to bring my output format.
Hope your understand,pls guide me or give me some sample code
So lets build the SQL dynamically each time it is run. Start with and then tune it to get your desired results --
Function fnMakeTheSQL(nMO As Long) As String
' define the output SQL string, and initialize it to blanks
Dim sSQL As String
sSQL = ""
' concat the first part of the SQL
sSQL = sSQL & " SELECT "
sSQL = sSQL & vbCrLf & " Name, "
sSQL = sSQL & vbCrLf & " M0, "
' now the interesting part, the LOOPing to build Prior & This month-s columns
Dim iMO As Long
For iMO = 1 To nMO
sSQL = sSQL & vbCrLf & " M" & iMO & ", "
Next iMO
' and more interesting part, the LOOPing to build Future ADJ columns
'Dim iMO As Long
For iMO = nMO + 1 To 12
sSQL = sSQL & vbCrLf & " ADJ_M" & iMO & ", "
Next iMO
' strip off the trailing comma
sSQL = Left(sSQL, InStrRev(sSQL, ",") - 1)
' concat the last part of the SQL
sSQL = sSQL & vbCrLf & " From yourTable "
sSQL = sSQL & vbCrLf & " Order By Name "
' give it back to the caller
fnMakeTheSQL = sSQL
End Function
When the month is 5, the resulting SQL is --
SELECT
Name,
M0,
M1,
M2,
M3,
M4,
M5,
ADJ_M6,
ADJ_M7,
ADJ_M8,
ADJ_M9,
ADJ_M10,
ADJ_M11,
ADJ_M12
From yourTable
Order By Name