Hi Guy's i am trying to output a recordset to Excel, working successfully with one little adjustment required, would appreciated if the code i post can be adjusted wherever the running sum needs to be ?
So if there is 5 records in rs record count
The first record is correct, the next 4 are incorrect, some of the fields (Cells) need to calculate from the last record ie: record 2 certain cells mentioned cells needs to from previous record then the calculation, same for record 3 needs to be record 1 and record 2 then the calculation etc
so record in this case the highlighted cells needs to be calculated from the 4 previous records then the calculation
Please forgive me if i haven't explained correctly but hope i have, i think I'm just mind boggled in how to do it!!!!!
Code
Record quantities may vary but never typically any more than 5 or 6Code:Dim pOpen As String, fOpen As String, apXL As Object, xlWB As Object, xlWS As ObjectDim rs As DAO.Recordset, strSQL As String, msMin As Integer, msMax As Integer Dim myDriver As String, myStart As Date, myEnd As Date Dim LR As Long If Me.txtIndexNo = "2" Then myDriver = Me.cboDriver myStart = Format(Me.txtStartDate, "mm/dd/yyyy") myEnd = Format(Me.txtEndDate, "mm/dd/yyyy") xlPath = "T:\DMT Ltd\XL Files\Driver Hours\" & Me.cboDriver & "\" xlFileName = Me.cboDriver & ".xlsx" Set rs = CurrentDb.OpenRecordset("Select tblDriverHours.StartDate, tblDriverHours.MSNo, tblDriverHours.StartTime, tblDriverHours.FinishTime, tblDriverHours.RestBreak, tblDriverHours.HoursDone, tblDriverHours.StdHours From tblDriverHours WHERE Driver = '" & myDriver & "' And StartDate Between #" & myStart & "# And #" & myEnd & "#") pOpen = "T:\DMT Ltd\XL Files\Driver Hours\" & Me.cboDriver & "\" fOpen = Me.cboDriver & ".xlsx" Set apXL = CreateObject("Excel.Application") Set xlWB = apXL.Workbooks.Open(pOpen & fOpen) apXL.Workbooks.Open pOpen & fOpen, True, False Set xlWS = xlWB.Worksheets("Time Sheet") apXL.Visible = False With xlWB rs.MoveFirst Do Until rs.EOF MsgBox ("There Are: " & rs.RecordCount & " Records To Output"), vbInformation + vbOKOnly, "RECORD COUNT" LR = xlWS.Cells(xlWS.Rows.Count, 1).End(xlUp).Row .Worksheets(1).Cells(LR + 1, 1) = Format(rs.Fields("StartDate"), "ddd-dd-mmm-yyyy") .Worksheets(1).Cells(LR + 1, 2) = rs.Fields("MSNo") .Worksheets(1).Cells(LR + 1, 3) = Format(rs.Fields("StartTime"), "00:00") .Worksheets(1).Cells(LR + 1, 4) = Format(rs.Fields("FinishTime"), "00:00") .Worksheets(1).Cells(LR + 1, 5) = rs.Fields("RestBreak") .Worksheets(1).Cells(LR + 1, 6) = rs.Fields("HoursDone") .Worksheets(1).Cells(LR + 1, 7) = rs.Fields("StdHours") .Worksheets(1).Cells(LR + 1, 8) = rs.Fields("StdHours") - rs.Fields("HoursDone") .Worksheets(1).Cells(LR + 1, 10) = rs.Fields("HoursDone") - rs.Fields("StdHours") - rs.Fields("RestBreak") .Worksheets(1).Cells(LR + 1, 11) = rs.Fields("StdHours") - rs.Fields("HoursDone") + rs.Fields("RestBreak") '.Worksheets(1).Cells(LR + 1, 1).CopyFromRecordset rs .Worksheets(1).Cells.EntireColumn.HorizontalAlignment = xlLeft rs.MoveNext Loop .Save End With xlWB.Close apXL.Quit Set xlWS = Nothing Set apXL = Nothing Set rs = Nothing MsgBox ("Sucessfully Updated" & vbNewLine & vbNewLine & _ "Click Open In Excel Button"), vbInformation + vbOKOnly, "UPDATE SUCESSFULL" End If
Result with records 2 to 5 incorrect values
![]()


Running Sum From rs To Excel
Reply With Quote



