VBA to get employee costs per month - ms-access

Question

I have a table that contains information about when employees started and ended and I want to get a report on how much was spent each month over time.
Here's the table (I'm simplifying a bit here for clarity)
Example:
EmployeeID, Name, Position, StartDate, EndDate, MonthlySalary
1, John Doe, Intern, 2/1/2010, 1/1/2013, $1,000
2, Jane Doe, CEO, 1/1/2010, , $10,000
3, Bob Doe, CFO, 2/1/2010, 2/1/2013, $8,000
...
The output I would like to get is a table that looks like this:
ExpenseDate, Amount, EmployeeCount
1/1/2010, $10,000, 1
2/1/2010, $11,000, 2
3/1/2010, $11,000, 2
4/1/2010, $19,000, 3
...
1/1/2013, $18,000, 2 -- intern left
2/1/2013, $10,000, 1 -- CFO left
...
3/1/2014, $10,000, 1 -- no end date for CEO
If the information was in this format below, I could pivot it pretty easily to get what I need above:
EmployeeID, ExpenseDate, Amount
1, 2/1/2010, $1,000
1, 3/1/2010, $1,000
1, 4/1/2010, $1,000
...
2, 2/1/2010, $10,000
2, 3/1/2010, $10,000
2, 4/1/2010, $10,000
...
Could one of these tables be created using some VBA code?
I'm using Access 2010 if it matters

Answer 1

The following code will use your existing data to build a table of payments for each employee, for each month employed. You need to address what to do for partial months pay (divide by 30?)
Option Compare Database
Option Explicit
Function Build_Emo_Pay_Table()
Dim strSQL As String
Dim dbs As DAO.Database
Dim rsIN As DAO.Recordset
Dim rsOT As DAO.Recordset
Dim iMonths As Integer
Dim iLoop As Integer
Dim datLast As Date
Set dbs = CurrentDb
On Error Resume Next
' !! NOTE !! Decide how to 'maintain' pay table. Choices are rebuild each time,
' or add new months, or adjust previous 'partial month'
' This code deletes table 'tblEmpPay' each time and rebuilds.
Debug.Print dbs.TableDefs("tblEmpPay").Name ' To raise error
If Err.Number = 0 Then
Debug.Print Err.Number & vbTab & Err.Description
dbs.TableDefs.Delete ("tblEmpPay")
End If
On Error GoTo 0
strSQL = "CREATE TABLE tblEmpPay (PayEmpID INT, PayDate Date, PayEmpPaid long);"
dbs.Execute strSQL
strSQL = "CREATE UNIQUE INDEX PayKey ON tblEmpPay (PayEmpID, PayDate) WITH DISALLOW NULL;"
dbs.Execute strSQL
strSQL = "select * from tblEmployee Order by EmpID;"
Set rsIN = dbs.OpenRecordset(strSQL)
Set rsOT = dbs.OpenRecordset("tblEmpPay", adOpenDynamic)
' Process each employee record
Do While Not rsIN.EOF
If IsDate(rsIN!empLeave) Then
datLast = rsIN!empLeave
Else
datLast = Date
End If
iMonths = DateDiff("m", rsIN!empStart, datLast) ' Get Months employeed (note will not get partial month!)
Debug.Print rsIN!empName & vbTab & rsIN!empStart & vbTab & rsIN!empLeave & vbTab & DateDiff("m", rsIN!empStart, rsIN!empLeave)
'!! NOTE !! Depending on how you want to handle partial months, change next line. i.e. If employee leaves
' on first day of month, or during the month, what is your formula for how much do they get paid?
For iLoop = 0 To iMonths - 1
rsOT.AddNew
rsOT!PayEmpID = rsIN!empId
rsOT!PayDate = DateAdd("m", iLoop, rsIN!empStart)
rsOT!PayEmpPaid = rsIN!empsalary
rsOT.Update
Next iLoop
rsIN.MoveNext
Loop
rsIN.Close
Set rsIN = Nothing
Set dbs = Nothing
End Function