Code to add monthly reocrds to table

[SMcGrath]

Currently I am trying to get records into a temporary depreciation table. I was using the code below to accomplish this but now I am told that we need to have a record for each project that has a status of new or in progress regardless of the year that the project started based on the starting month of the project (project 2 estimated start date is February, then I need 11 records for February-December). So my question is how do I change the calculation for the months.



Private Sub CmdDepRpt_Click()
On Error GoTo ErrHandling

Dim db As Database
Dim qdf As QueryDef
Dim rsin As Recordset
Dim rsout As Recordset
Dim prm As DAO.Parameter


Set db = CurrentDb
Set qdf = db.QueryDefs("Query1")
Set rsin = qdf.OpenRecordset()
Set rsout = db.OpenRecordset("TblTempDepreciation")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm


db.Execute "QryDeleteTblTemp"
rsin.MoveFirst
Dim Amount As Double, months As Integer, d As Date, sd As Date, i As Integer
Do While Not rsin.EOF
sd = rsin("EstStartDate")
months = DateDiff("m", sd, DateSerial(Year(Date), 12, 31)) + 1
Amount = rsin("CapitalAmt") / rsin("DepMos")
d = DateSerial(Year(sd), Month(sd), 1)
For i = 0 To months - 1
rsout.AddNew
rsout("EndDate") = DateAdd("m", i, sd)
rsout("DepreciationAmt") = Amount
rsout("ProjectID") = rsin("ProjectID")
rsout("EstStartDate") = sd
rsout("months") = months
rsout.Update

Next
rsin.MoveNext
Loop
DoCmd.OpenReport "RptBudgetCrosstab", acViewPreview


EndIt:
Exit Sub ' or Exit Function
ErrHandling:
Select Case Err.Number
Case 94
MsgBox "Warning! One or more budget items have no depreciation term The report is cancelled."
Case Else
MsgBox Err.Description
End Select
Resume EndIt
End Sub

[ItsMe]

You are appending another table?
You have two sets of criteria?
Perhaps two queries that run two procedures. One for each set of criteria.

If this will create duplicate records in you new temp table, then you should be able to combine the criteria into a single query and run it once. Have you tried creating a select query for TblTempDepreciation that meets the needs?

[Dal Jeanis]

1) Is Query1 is taking care of the "new or in progress" portion of your requirements?
2) Isn't there an estimated completion date for your projects? I would expect depreciation to be across the entire project, rather than just to the end of whatever year you are reporting?

[SMcGrath]

Query 1 is accounting for the "new" and "in progress" status and the end date is 12/31/13 due to my adding the number of months to the start date but I now I just want the end date to be the month of December regardless of the start date because I just need the start month. Here is the query:

SELECT TblProject.ProjectID, TblProject.CatType, TblProject.ProjectNum, TblProject.EstStartDate, TblProject.ProjectDesc, TblProject.CapitalAmt, TblProject.DepYrs, [CapitalAmt]/[DepMos] AS Depreciation, [DepYrs]*12 AS DepMos, TblCategory.GLNum, DateDiff("m",[EstStartDate],DateSerial(Year(Date()),12,31)) AS NumMo, DateAdd("m",[numMo],[EstStartDate]) AS EndDate, DateSerial(Year([EstStartDate]),Month([EstStartDate]),1) AS SD, TblProject.StartYr, TblProject.Status, 12 AS EstEndMo, DatePart("m",[EstStartDate]) AS EstStartMo, "1081" & "-" & [GLNum] & "-" & [CostCenter] AS GL
FROM TblDepartment INNER JOIN (TblProject INNER JOIN TblCategory ON TblProject.CatType = TblCategory.CategoryID) ON TblDepartment.DepartmentID = TblProject.DeptNum
WHERE (((TblProject.Status) In (1,5)));

[Dal Jeanis]

I've assumed in this code that your "EndDate" is supposed to be the first of each successive month, rather than the end of that month. If it should be the end of the month, then adjust Jan1 to Jan31 and fDate to "DateSerial(ThisYear,Month(sDate),31)".
I've optimized the code a bit by calculating static dates once, then using those calculated value, rather than recalculating them each time through.

db.Execute "QryDeleteTblTemp"
rsin.MoveFirst

Dim Amount As Double, months As Integer, i As Integer
Dim ThisYear as integer
Dim WorkDate As Date, sDate As Date, fDate as Date
Dim Jan1 As Date, Feb1 As Date, Dec31 As Date

Dec31 = DateSerial(Year(Date), 12, 31))  ' last day of this year
Jan1  = DateSerial(Year(Date), 01, 01))  ' Jan 1 of this year
Feb1  = DateSerial(Year(Date), 02, 01))  ' Feb 1 of this year
ThisYear = Year(Date)

Do While Not rsin.EOF
   sDate = rsin("EstStartDate")

   ' If estStartDate is after Feb 1 of this year, use first day 
   ' of sDate's month,
   ' otherwise start Jan 1 of this year.
   if sDate < Feb1 Then
      fDate = Jan1
      months = 12
   Else 
      fDate = DateSerial(ThisYear,Month(sDate),01)
      months = 13 - Month(sDate)
   End if

   Amount = rsin("CapitalAmt") / rsin("DepMos")
   For i = 0 To months - 1
      rsout.AddNew
      rsout("EndDate") = DateAdd("m", i, fDate)
      rsout("DepreciationAmt") = Amount
      rsout("ProjectID") = rsin("ProjectID")
      rsout("EstStartDate") = sDate
      rsout("months") = months
      rsout.Update
   Next i

   rsin.MoveNext
   Loop