Problem with Do While

P

Pat

I have a dataset of hours charged against projects. The data is daily
time-keeping records. I am looking to sum the data by project, by half
of the year (1st half-2nd half). I want all the data to be shown only
in the half that the final time entries occurred (the system has no
concept of a project's start and end date, so I have to use the last
of the project hours entries to extrapolate the end of the project).
There are records that span as many as 6 halves, so I have to find
some way to total up all the hours, and only report them in the last
half. I've started out trying to loop through the records, comparing
row by row, saving each half's data into differnt variables until I
get to the last one, then updating the last one with the total hours,
and setting the half value for all the other records to 0 so I can go
back and delete them later (I'm doing all this in a work table). I've
gotten hung up with this approach, and feel like I've probably taken
the wrong approach. I'm copying in my module contents below. Any
suggestions?

Function fGetProjectPerformanceDataByHalf()

Dim intYear As Integer
Dim intQuarter As Integer
Dim intHalf As Integer
Dim intYearHalf As Integer
Dim dblActual As Double
Dim strSQL As String
Dim db As Database
Dim rst As Recordset
Dim strProjectCode1 As String
Dim strProjectCode2 As String
Dim strProjectCode3 As String
Dim strProjectCode4 As String
Dim strProjectCode5 As String
Dim strProjectCode6 As String
Dim intYear1 As Integer
Dim intYear2 As Integer
Dim intYear3 As Integer
Dim intYear4 As Integer
Dim intYear5 As Integer
Dim intYear6 As Integer
Dim intQuarter1 As Integer
Dim intQuarter2 As Integer
Dim intQuarter3 As Integer
Dim intQuarter4 As Integer
Dim intQuarter5 As Integer
Dim intQuarter6 As Integer
Dim intHalf1 As Integer
Dim intHalf2 As Integer
Dim intHalf3 As Integer
Dim intHalf4 As Integer
Dim intHalf5 As Integer
Dim intHalf6 As Integer
Dim dblActual1 As Double
Dim dblActual2 As Double
Dim dblActual3 As Double
Dim dblActual4 As Double
Dim dblActual5 As Double
Dim dblActual6 As Double
Dim intYearHalf1 As Integer
Dim intYearHalf2 As Integer
Dim intYearHalf3 As Integer
Dim intYearHalf4 As Integer
Dim intYearHalf5 As Integer
Dim intYearHalf6 As Integer

'DoCmd.OpenForm "frmBusy", acNormal, , , acFormReadOnly,
acWindowNormal
'DoCmd.Hourglass True
DoCmd.SetWarnings False

Set db = CurrentDb()

'Delete contents of the table
sSQL = "DELETE * FROM tblTEMPBudgetActualDataByHalf"
DoCmd.RunSQL sSQL

'Get data to seed the table
sSQL = "INSERT INTO tblTEMPBudgetActualDataByHalf ( OEM,
ProjectCode, ProjectName, [Year], Quarter, Half, ActualHours ) " _
& "SELECT qryDetails.OEM, qryDetails.ProjectCode,
qryDetails.ProjectName, Year([Date]) AS [Year], " _
& "DatePart(""q"",[Date]) AS Quarter, 0 AS Half, Sum
(qryDetails.Hours) AS ActualHours " _
& "FROM qryDetails INNER JOIN tblPSProjects ON
qryDetails.ProjectCode = tblPSProjects.ProjectCode " _
& "GROUP BY qryDetails.OEM, qryDetails.ProjectCode,
qryDetails.ProjectName, Year([Date]), DatePart(""q"",[Date]) " _
& "ORDER BY qryDetails.ProjectCode, Year([Date]), DatePart
(""q"",[Date])"
DoCmd.RunSQL sSQL

'Set initial half values
sSQL = "UPDATE tblTEMPBudgetActualDataByHalf " _
& "SET Half = 1 " _
& "WHERE Quarter IN (1,2)"
DoCmd.RunSQL sSQL

sSQL = "UPDATE tblTEMPBudgetActualDataByHalf " _
& "SET Half = 2 " _
& "WHERE Quarter IN (3,4)"
DoCmd.RunSQL sSQL

'Update the Budget data
sSQL = "UPDATE tblTEMPBudgetActualDataByHalf INNER JOIN
tblPSProjects " _
& "ON tblTEMPBudgetActualDataByHalf.ProjectCode =
tblPSProjects.ProjectCode " _
& "SET tblTEMPBudgetActualDataByHalf.Budget = " _
& "([tblPSProjects].[PMBudgetAmount]+[tblPSProjects].
[DesBudgetAmount]+[tblPSProjects].[DevBudgetAmount]+[tblPSProjects].
[IntBudgetAmount]+[tblPSProjects].[QABudgetAmount]+[tblPSProjects].
[PDBudgetAmount]+[tblPSProjects].[OtherBudgetAmount])"
DoCmd.RunSQL sSQL

'Clean up records for projects with no budgets
sSQL = "DELETE * FROM tblTEMPBudgetActualDataByHalf " _
& "WHERE Budget = 0"
DoCmd.RunSQL sSQL

'Update the half data
sSQL = "Select ProjectCode, Year, Half, ActualHours from
tblTEMPBudgetActualDataByHalf " _
& "ORDER BY ProjectCode, Year, Half"
Set rst = db.OpenRecordset(sSQL)
rst.MoveLast
rst.MoveFirst
strProjectCode1 = rst!ProjectCode.Value
intYear1 = rst!Year.Value
intHalf1 = rst!Half.Value
dblActual1 = rst!ActualHours.Value
intYearHalf1 = CInt(CStr(intYear1) & CStr(intHalf1))
Do While Not rst.EOF
Start: rst.MoveNext
strProjectCode2 = rst!ProjectCode.Value
intYear2 = rst!Year.Value
intHalf2 = rst!Half.Value
dblActual2 = rst!ActualHours.Value
intYearHalf2 = CInt(CStr(intYear2) & CStr(intHalf2))
If strProjectCode1 <> strProjectCode2 Then
strProjectCode1 = strProjectCode2
intYear1 = intYear2
intHalf1 = intHalf2
dblActual1 = dblActual2
intYearHalf1 = intYearHalf2
GoTo Start
Else
rst.MoveNext
strProjectCode3 = rst!ProjectCode.Value
intYear3 = rst!Year.Value
intHalf3 = rst!Half.Value
dblActual3 = rst!ActualHours.Value
intYearHalf3 = CInt(CStr(intYear3) & CStr
(intHalf3))
If strProjectCode2 <> strProjectCode3 Then
dblActual4 = dblActual1 + dblActual2
If intYearHalf2 > intYearHalf1 Then
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET ActualHours = " & dblActual4 &
" " _
& "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
& "AND Year = " & intYear2 & " " _
& "AND Half = " & intHalf2 & ""
DoCmd.RunSQL sSQL
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET Half = 0 " _
& "WHERE ProjectCode = '" &
strProjectCode1 & "' " _
& "AND Year = " & intYear1 & " " _
& "AND Half = " & intHalf1 & ""
DoCmd.RunSQL sSQL
Else
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET ActualHours = " & dblActual4 &
" " _
& "WHERE ProjectCode = '" &
strProjectCode1 & "' " _
& "AND Year = " & intYear1 & " " _
& "AND Half = " & intHalf1 & ""
DoCmd.RunSQL sSQL
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET Half = 0 " _
& "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
& "AND Year = " & intYear2 & " " _
& "AND Half = " & intHalf2 & ""
DoCmd.RunSQL sSQL
End If
strProjectCode1 = strProjectCode3
intYear1 = intYear3
intHalf1 = intHalf3
dblActual1 = dblActual3
intYearHalf1 = intYearHalf3
GoTo Start
Else
rst.MoveNext
strProjectCode4 = rst!ProjectCode.Value
intYear4 = rst!Year.Value
intHalf4 = rst!Half.Value
dblActual4 = rst!ActualHours.Value
intYearHalf4 = CInt(CStr(intYear4) & CStr
(intHalf4))
If strProjectCode3 <> strProjectCode4 Then
dblActual4 = dblActual1 + dblActual2
If intYearHalf2 > intYearHalf1 Then
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET ActualHours = " &
dblActual4 & " " _
& "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
& "AND Year = " & intYear2 & " " _
& "AND Half = " & intHalf2 & ""
DoCmd.RunSQL sSQL
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET Half = 0 " _
& "WHERE ProjectCode = '" &
strProjectCode1 & "' " _
& "AND Year = " & intYear1 & " " _
& "AND Half = " & intHalf1 & ""
DoCmd.RunSQL sSQL
Else
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET ActualHours = " &
dblActual4 & " " _
& "WHERE ProjectCode = '" &
strProjectCode1 & "' " _
& "AND Year = " & intYear1 & " " _
& "AND Half = " & intHalf1 & ""
DoCmd.RunSQL sSQL
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET Half = 0 " _
& "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
& "AND Year = " & intYear2 & " " _
& "AND Half = " & intHalf2 & ""
DoCmd.RunSQL sSQL
End If
strProjectCode1 = strProjectCode3
intYear1 = intYear3
intHalf1 = intHalf3
dblActual1 = dblActual3
intYearHalf1 = intYearHalf3
GoTo Start
End If
End If
Loop



rst.Close



'Open the results query
Set db = Nothing
Set rst = Nothing

'DoCmd.Close acForm, "frmBusy", acSaveNo
'DoCmd.Hourglass False
DoCmd.SetWarnings True
DoCmd.OpenQuery "qryProjectBudgetPerformanceByHalf", acViewNormal,
acReadOnly

End Function
 
K

KC-Mass

How about if you just ran a query against your data. Assuming you have a
field like "ProjectID", another like "DateofEntry" and lastly "HoursBilled".

Something like: SELECT ProjectID, Sum(HoursBilled) AS TotalHoursBilled,
Max(DateOfEntry) AS MaxOfDateOfEntry
FROM tblProjects
GROUP BY ProjectID;

That would give the total of all hours by project and the last date hours
( or whatever) were billed to it.

You could then probably use another query to update the halves.




Pat said:
I have a dataset of hours charged against projects. The data is daily
time-keeping records. I am looking to sum the data by project, by half
of the year (1st half-2nd half). I want all the data to be shown only
in the half that the final time entries occurred (the system has no
concept of a project's start and end date, so I have to use the last
of the project hours entries to extrapolate the end of the project).
There are records that span as many as 6 halves, so I have to find
some way to total up all the hours, and only report them in the last
half. I've started out trying to loop through the records, comparing
row by row, saving each half's data into differnt variables until I
get to the last one, then updating the last one with the total hours,
and setting the half value for all the other records to 0 so I can go
back and delete them later (I'm doing all this in a work table). I've
gotten hung up with this approach, and feel like I've probably taken
the wrong approach. I'm copying in my module contents below. Any
suggestions?

Function fGetProjectPerformanceDataByHalf()

Dim intYear As Integer
Dim intQuarter As Integer
Dim intHalf As Integer
Dim intYearHalf As Integer
Dim dblActual As Double
Dim strSQL As String
Dim db As Database
Dim rst As Recordset
Dim strProjectCode1 As String
Dim strProjectCode2 As String
Dim strProjectCode3 As String
Dim strProjectCode4 As String
Dim strProjectCode5 As String
Dim strProjectCode6 As String
Dim intYear1 As Integer
Dim intYear2 As Integer
Dim intYear3 As Integer
Dim intYear4 As Integer
Dim intYear5 As Integer
Dim intYear6 As Integer
Dim intQuarter1 As Integer
Dim intQuarter2 As Integer
Dim intQuarter3 As Integer
Dim intQuarter4 As Integer
Dim intQuarter5 As Integer
Dim intQuarter6 As Integer
Dim intHalf1 As Integer
Dim intHalf2 As Integer
Dim intHalf3 As Integer
Dim intHalf4 As Integer
Dim intHalf5 As Integer
Dim intHalf6 As Integer
Dim dblActual1 As Double
Dim dblActual2 As Double
Dim dblActual3 As Double
Dim dblActual4 As Double
Dim dblActual5 As Double
Dim dblActual6 As Double
Dim intYearHalf1 As Integer
Dim intYearHalf2 As Integer
Dim intYearHalf3 As Integer
Dim intYearHalf4 As Integer
Dim intYearHalf5 As Integer
Dim intYearHalf6 As Integer

'DoCmd.OpenForm "frmBusy", acNormal, , , acFormReadOnly,
acWindowNormal
'DoCmd.Hourglass True
DoCmd.SetWarnings False

Set db = CurrentDb()

'Delete contents of the table
sSQL = "DELETE * FROM tblTEMPBudgetActualDataByHalf"
DoCmd.RunSQL sSQL

'Get data to seed the table
sSQL = "INSERT INTO tblTEMPBudgetActualDataByHalf ( OEM,
ProjectCode, ProjectName, [Year], Quarter, Half, ActualHours ) " _
& "SELECT qryDetails.OEM, qryDetails.ProjectCode,
qryDetails.ProjectName, Year([Date]) AS [Year], " _
& "DatePart(""q"",[Date]) AS Quarter, 0 AS Half, Sum
(qryDetails.Hours) AS ActualHours " _
& "FROM qryDetails INNER JOIN tblPSProjects ON
qryDetails.ProjectCode = tblPSProjects.ProjectCode " _
& "GROUP BY qryDetails.OEM, qryDetails.ProjectCode,
qryDetails.ProjectName, Year([Date]), DatePart(""q"",[Date]) " _
& "ORDER BY qryDetails.ProjectCode, Year([Date]), DatePart
(""q"",[Date])"
DoCmd.RunSQL sSQL

'Set initial half values
sSQL = "UPDATE tblTEMPBudgetActualDataByHalf " _
& "SET Half = 1 " _
& "WHERE Quarter IN (1,2)"
DoCmd.RunSQL sSQL

sSQL = "UPDATE tblTEMPBudgetActualDataByHalf " _
& "SET Half = 2 " _
& "WHERE Quarter IN (3,4)"
DoCmd.RunSQL sSQL

'Update the Budget data
sSQL = "UPDATE tblTEMPBudgetActualDataByHalf INNER JOIN
tblPSProjects " _
& "ON tblTEMPBudgetActualDataByHalf.ProjectCode =
tblPSProjects.ProjectCode " _
& "SET tblTEMPBudgetActualDataByHalf.Budget = " _
& "([tblPSProjects].[PMBudgetAmount]+[tblPSProjects].
[DesBudgetAmount]+[tblPSProjects].[DevBudgetAmount]+[tblPSProjects].
[IntBudgetAmount]+[tblPSProjects].[QABudgetAmount]+[tblPSProjects].
[PDBudgetAmount]+[tblPSProjects].[OtherBudgetAmount])"
DoCmd.RunSQL sSQL

'Clean up records for projects with no budgets
sSQL = "DELETE * FROM tblTEMPBudgetActualDataByHalf " _
& "WHERE Budget = 0"
DoCmd.RunSQL sSQL

'Update the half data
sSQL = "Select ProjectCode, Year, Half, ActualHours from
tblTEMPBudgetActualDataByHalf " _
& "ORDER BY ProjectCode, Year, Half"
Set rst = db.OpenRecordset(sSQL)
rst.MoveLast
rst.MoveFirst
strProjectCode1 = rst!ProjectCode.Value
intYear1 = rst!Year.Value
intHalf1 = rst!Half.Value
dblActual1 = rst!ActualHours.Value
intYearHalf1 = CInt(CStr(intYear1) & CStr(intHalf1))
Do While Not rst.EOF
Start: rst.MoveNext
strProjectCode2 = rst!ProjectCode.Value
intYear2 = rst!Year.Value
intHalf2 = rst!Half.Value
dblActual2 = rst!ActualHours.Value
intYearHalf2 = CInt(CStr(intYear2) & CStr(intHalf2))
If strProjectCode1 <> strProjectCode2 Then
strProjectCode1 = strProjectCode2
intYear1 = intYear2
intHalf1 = intHalf2
dblActual1 = dblActual2
intYearHalf1 = intYearHalf2
GoTo Start
Else
rst.MoveNext
strProjectCode3 = rst!ProjectCode.Value
intYear3 = rst!Year.Value
intHalf3 = rst!Half.Value
dblActual3 = rst!ActualHours.Value
intYearHalf3 = CInt(CStr(intYear3) & CStr
(intHalf3))
If strProjectCode2 <> strProjectCode3 Then
dblActual4 = dblActual1 + dblActual2
If intYearHalf2 > intYearHalf1 Then
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET ActualHours = " & dblActual4 &
" " _
& "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
& "AND Year = " & intYear2 & " " _
& "AND Half = " & intHalf2 & ""
DoCmd.RunSQL sSQL
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET Half = 0 " _
& "WHERE ProjectCode = '" &
strProjectCode1 & "' " _
& "AND Year = " & intYear1 & " " _
& "AND Half = " & intHalf1 & ""
DoCmd.RunSQL sSQL
Else
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET ActualHours = " & dblActual4 &
" " _
& "WHERE ProjectCode = '" &
strProjectCode1 & "' " _
& "AND Year = " & intYear1 & " " _
& "AND Half = " & intHalf1 & ""
DoCmd.RunSQL sSQL
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET Half = 0 " _
& "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
& "AND Year = " & intYear2 & " " _
& "AND Half = " & intHalf2 & ""
DoCmd.RunSQL sSQL
End If
strProjectCode1 = strProjectCode3
intYear1 = intYear3
intHalf1 = intHalf3
dblActual1 = dblActual3
intYearHalf1 = intYearHalf3
GoTo Start
Else
rst.MoveNext
strProjectCode4 = rst!ProjectCode.Value
intYear4 = rst!Year.Value
intHalf4 = rst!Half.Value
dblActual4 = rst!ActualHours.Value
intYearHalf4 = CInt(CStr(intYear4) & CStr
(intHalf4))
If strProjectCode3 <> strProjectCode4 Then
dblActual4 = dblActual1 + dblActual2
If intYearHalf2 > intYearHalf1 Then
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET ActualHours = " &
dblActual4 & " " _
& "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
& "AND Year = " & intYear2 & " " _
& "AND Half = " & intHalf2 & ""
DoCmd.RunSQL sSQL
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET Half = 0 " _
& "WHERE ProjectCode = '" &
strProjectCode1 & "' " _
& "AND Year = " & intYear1 & " " _
& "AND Half = " & intHalf1 & ""
DoCmd.RunSQL sSQL
Else
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET ActualHours = " &
dblActual4 & " " _
& "WHERE ProjectCode = '" &
strProjectCode1 & "' " _
& "AND Year = " & intYear1 & " " _
& "AND Half = " & intHalf1 & ""
DoCmd.RunSQL sSQL
sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
& "SET Half = 0 " _
& "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
& "AND Year = " & intYear2 & " " _
& "AND Half = " & intHalf2 & ""
DoCmd.RunSQL sSQL
End If
strProjectCode1 = strProjectCode3
intYear1 = intYear3
intHalf1 = intHalf3
dblActual1 = dblActual3
intYearHalf1 = intYearHalf3
GoTo Start
End If
End If
Loop



rst.Close



'Open the results query
Set db = Nothing
Set rst = Nothing

'DoCmd.Close acForm, "frmBusy", acSaveNo
'DoCmd.Hourglass False
DoCmd.SetWarnings True
DoCmd.OpenQuery "qryProjectBudgetPerformanceByHalf", acViewNormal,
acReadOnly

End Function
Click to expand...
 
P

Pat

Great minds, KC Mass! I had actually already thought of that myself,
and implemented that approach this morning. Works like a champ. Thanks
for the feedback!

How about if you just ran a query against your data.  Assuming you havea
field like "ProjectID", another like "DateofEntry" and lastly "HoursBilled".

Something like: SELECT ProjectID, Sum(HoursBilled) AS TotalHoursBilled,
Max(DateOfEntry) AS MaxOfDateOfEntry
FROM tblProjects
GROUP BY ProjectID;

That would give the total of all hours by project and the last date hours
( or whatever) were billed to it.

You could then probably use another query to update the halves.




I have a dataset of hours charged against projects. The data is daily
time-keeping records. I am looking to sum the data by project, by half
of the year (1st half-2nd half). I want all the data to be shown only
in the half that the final time entries occurred (the system has no
concept of a project's start and end date, so I have to use the last
of the project hours entries to extrapolate the end of the project).
There are records that span as many as 6 halves, so I have to find
some way to total up all the hours, and only report them in the last
half. I've started out trying to loop through the records, comparing
row by row, saving each half's data into differnt variables until I
get to the last one, then updating the last one with the total hours,
and setting the half value for all the other records to 0 so I can go
back and delete them later (I'm doing all this in a work table). I've
gotten hung up with this approach, and feel like I've probably taken
the wrong approach. I'm copying in my module contents below. Any
suggestions?
Click to expand...
Function fGetProjectPerformanceDataByHalf()
Click to expand...
   Dim intYear As Integer
   Dim intQuarter As Integer
   Dim intHalf As Integer
   Dim intYearHalf As Integer
   Dim dblActual As Double
   Dim strSQL As String
   Dim db As Database
   Dim rst As Recordset
   Dim strProjectCode1 As String
   Dim strProjectCode2 As String
   Dim strProjectCode3 As String
   Dim strProjectCode4 As String
   Dim strProjectCode5 As String
   Dim strProjectCode6 As String
   Dim intYear1 As Integer
   Dim intYear2 As Integer
   Dim intYear3 As Integer
   Dim intYear4 As Integer
   Dim intYear5 As Integer
   Dim intYear6 As Integer
   Dim intQuarter1 As Integer
   Dim intQuarter2 As Integer
   Dim intQuarter3 As Integer
   Dim intQuarter4 As Integer
   Dim intQuarter5 As Integer
   Dim intQuarter6 As Integer
   Dim intHalf1 As Integer
   Dim intHalf2 As Integer
   Dim intHalf3 As Integer
   Dim intHalf4 As Integer
   Dim intHalf5 As Integer
   Dim intHalf6 As Integer
   Dim dblActual1 As Double
   Dim dblActual2 As Double
   Dim dblActual3 As Double
   Dim dblActual4 As Double
   Dim dblActual5 As Double
   Dim dblActual6 As Double
   Dim intYearHalf1 As Integer
   Dim intYearHalf2 As Integer
   Dim intYearHalf3 As Integer
   Dim intYearHalf4 As Integer
   Dim intYearHalf5 As Integer
   Dim intYearHalf6 As Integer
Click to expand...
   'DoCmd.OpenForm "frmBusy", acNormal, , , acFormReadOnly,
acWindowNormal
   'DoCmd.Hourglass True
   DoCmd.SetWarnings False
Click to expand...
   Set db = CurrentDb()
Click to expand...
   'Delete contents of the table
   sSQL = "DELETE * FROM tblTEMPBudgetActualDataByHalf"
   DoCmd.RunSQL sSQL
Click to expand...
   'Get data to seed the table
   sSQL = "INSERT INTO tblTEMPBudgetActualDataByHalf ( OEM,
ProjectCode, ProjectName, [Year], Quarter, Half, ActualHours ) " _
       & "SELECT qryDetails.OEM, qryDetails.ProjectCode,
qryDetails.ProjectName, Year([Date]) AS [Year], " _
       & "DatePart(""q"",[Date]) AS Quarter, 0 AS Half, Sum
(qryDetails.Hours) AS ActualHours " _
       & "FROM qryDetails INNER JOIN tblPSProjects ON
qryDetails.ProjectCode = tblPSProjects.ProjectCode " _
       & "GROUP BY qryDetails.OEM, qryDetails.ProjectCode,
qryDetails.ProjectName, Year([Date]), DatePart(""q"",[Date]) " _
       & "ORDER BY qryDetails.ProjectCode, Year([Date]), DatePart
(""q"",[Date])"
   DoCmd.RunSQL sSQL
Click to expand...
   'Set initial half values
   sSQL = "UPDATE tblTEMPBudgetActualDataByHalf " _
       & "SET Half = 1 " _
       & "WHERE Quarter IN (1,2)"
   DoCmd.RunSQL sSQL
Click to expand...
   sSQL = "UPDATE tblTEMPBudgetActualDataByHalf " _
       & "SET Half = 2 " _
       & "WHERE Quarter IN (3,4)"
   DoCmd.RunSQL sSQL
Click to expand...
   'Update the Budget data
   sSQL = "UPDATE tblTEMPBudgetActualDataByHalf INNER JOIN
tblPSProjects " _
       & "ON tblTEMPBudgetActualDataByHalf.ProjectCode =
tblPSProjects.ProjectCode " _
       & "SET tblTEMPBudgetActualDataByHalf.Budget = " _
       & "([tblPSProjects].[PMBudgetAmount]+[tblPSProjects].
[DesBudgetAmount]+[tblPSProjects].[DevBudgetAmount]+[tblPSProjects].
[IntBudgetAmount]+[tblPSProjects].[QABudgetAmount]+[tblPSProjects].
[PDBudgetAmount]+[tblPSProjects].[OtherBudgetAmount])"
   DoCmd.RunSQL sSQL
Click to expand...
   'Clean up records for projects with no budgets
   sSQL = "DELETE * FROM tblTEMPBudgetActualDataByHalf " _
       & "WHERE Budget = 0"
   DoCmd.RunSQL sSQL
Click to expand...
   'Update the half data
   sSQL = "Select ProjectCode, Year, Half, ActualHours from
tblTEMPBudgetActualDataByHalf " _
       & "ORDER BY ProjectCode, Year, Half"
   Set rst = db.OpenRecordset(sSQL)
   rst.MoveLast
   rst.MoveFirst
       strProjectCode1 = rst!ProjectCode.Value
       intYear1 = rst!Year.Value
       intHalf1 = rst!Half.Value
       dblActual1 = rst!ActualHours.Value
       intYearHalf1 = CInt(CStr(intYear1) & CStr(intHalf1))
           Do While Not rst.EOF
Start:          rst.MoveNext
               strProjectCode2 = rst!ProjectCode.Value
               intYear2 = rst!Year.Value
               intHalf2 = rst!Half.Value
               dblActual2 = rst!ActualHours.Value
               intYearHalf2 = CInt(CStr(intYear2) & CStr(intHalf2))
               If strProjectCode1 <> strProjectCode2 Then
                   strProjectCode1 = strProjectCode2
                   intYear1 = intYear2
                   intHalf1 = intHalf2
                   dblActual1 = dblActual2
                   intYearHalf1 = intYearHalf2
                   GoTo Start
               Else
                   rst.MoveNext
                   strProjectCode3 = rst!ProjectCode.Value
                   intYear3 = rst!Year.Value
                   intHalf3 = rst!Half.Value
                   dblActual3 = rst!ActualHours.Value
                   intYearHalf3 = CInt(CStr(intYear3) & CStr
(intHalf3))
                   If strProjectCode2 <> strProjectCode3 Then
                       dblActual4 = dblActual1 + dblActual2
                       If intYearHalf2 > intYearHalf1 Then
                           sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
                               & "SET ActualHours = " & dblActual4 &
" " _
                               & "WHEREProjectCode = '" &
strProjectCode2 & "' " _
                               & "AND Year = " & intYear2 & " " _
                               & "AND Half = " & intHalf2 & ""
                           DoCmd.RunSQL sSQL
                           sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
                               & "SET Half = 0 " _
                               & "WHEREProjectCode = '" &
strProjectCode1 & "' " _
                               & "AND Year = " & intYear1 & " " _
                               & "AND Half = " & intHalf1 & ""
                           DoCmd.RunSQL sSQL
                       Else
                           sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
                               & "SET ActualHours = " & dblActual4 &
" " _
                               & "WHEREProjectCode = '" &
strProjectCode1 & "' " _
                               & "AND Year = " & intYear1 & " " _
                               & "AND Half = " & intHalf1 & ""
                           DoCmd.RunSQL sSQL
                           sSQL = "UPDATE
tblTEMPBudgetActualDataByHalf " _
                               & "SET Half = 0 " _
                               & "WHEREProjectCode = '" &
strProjectCode2 & "' " _
                               & "AND Year = " & intYear2 & " " _
                               & "AND Half = " & intHalf2 & ""
                           DoCmd.RunSQL sSQL
                       End If
                       strProjectCode1 = strProjectCode3
                       intYear1 = intYear3
                       intHalf1 = intHalf3
                       dblActual1 = dblActual3
                       intYearHalf1 = intYearHalf3
                       GoTo Start
                   Else
                       rst.MoveNext
                       strProjectCode4 = rst!ProjectCode.Value
                       intYear4 = rst!Year.Value
                       intHalf4 = rst!Half.Value
                       dblActual4 = rst!ActualHours.Value
                       intYearHalf4 = CInt(CStr(intYear4) & CStr
(intHalf4))
                       If strProjectCode3 <> strProjectCode4 Then
                           dblActual4 = dblActual1 + dblActual2
                           If intYearHalf2 > intYearHalf1 Then
                               sSQL ="UPDATE
tblTEMPBudgetActualDataByHalf " _
                                   & "SET ActualHours = " &
dblActual4 & " " _
                                   & "WHERE ProjectCode = '" &
strProjectCode2 & "' " _
                                   & "AND Year = " & intYear2 & " " _
                                   & "AND Half = " & intHalf2 & ""
                               DoCmd.RunSQL sSQL
                               sSQL ="UPDATE
tblTEMPBudgetActualDataByHalf " _
                                   & "SET Half = 0 " _
                                   & "WHERE
Click to expand...

...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...
 
Top