Home > Net >  Excel 2007, VBA: Retail 6.5.1057 -- Application.WorksheetFunction.Average()
Excel 2007, VBA: Retail 6.5.1057 -- Application.WorksheetFunction.Average()

Time:03-26

Apologies, the formatting is not cooperating with my browser.

Edition Windows 10 Pro

Version 21H2 OS build 19044.1586 Excel 2007, VBA: Retail 6.5.1057 - Forms3: 12.0.6723.500

THE CONCERN:

Sheets("SUMMARY").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = _
                        Application.WorksheetFunction.Average(irng)

When the above code is used 'manually' (F5), in the module below, it works perfectly every time. However, when the 'timer' triggers/engages, the procedure breaks/stops dead at that very line .

I have no clue how to troubleshoot this concern. I've spread the code over multiple procedures in an effort to troubleshoot; didn't help my cause at all.

Respectfully.

    Option Explicit
    Public RunWhen As Double
    Public Const cRunWhat = "kcal"  ' the name of the procedure to run
    Sub StartTimer()
    RunWhen = TimeSerial(23, 45, 0)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
    End Sub

    Private Sub kcal()
    Sheets("SUMMARY").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Date
    Sheets("SUMMARY").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Sheets("TODAY_(24hr)").Range("E40").Value

    kcal2
    End Sub

    Sub kcal2()
    Dim i As String
    Dim irng As Range
    i = Sheets("SUMMARY").Cells(Rows.Count, 2).End(xlUp).Address
    Set irng = Range("B2:" & i)

    Sheets("SUMMARY").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Average(irng)
 
    ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & "\Back_Up\Bak-Up_" & Format(Now, "yyyymmdd") & "_m" & ActiveWorkbook.Name

    StartTimer


    End Sub

CodePudding user response:

Try this:

Sub kcal2()
    
    Dim irng As Range
    
    With Sheets("SUMMARY")  'make sure all ranges are tied to a specific sheet
         Set irng = .Range("B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
         .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0) = _
                        Application.WorksheetFunction.Average(irng)
    End With
    ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & _
        "\Back_Up\Bak-Up_" & Format(Now, "yyyymmdd") & "_m" & ActiveWorkbook.Name

    StartTimer

End Sub

CodePudding user response:

Application.OnTime

  • If this shouldn't happen in the workbook containing this code, replace all occurrences of ThisWorkbook with the correct workbook e.g. ActiveWorkbook.
Option Explicit

Public RunWhen As Double
Public Const cRunWhat = "kcal"  ' the name of the procedure to run

Sub StartTimer()
    RunWhen = TimeSerial(23, 45, 0)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
End Sub

Private Sub kcal()
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("TODAY_(24hr)")
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("SUMMARY")
    dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = Date
    dws.Cells(dws.Rows.Count, "B").End(xlUp).Offset(1, 0).Value _
        = sws.Range("E40").Value
    kcal2
End Sub

Sub kcal2()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("SUMMARY")
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim irng As Range: Set irng = ws.Range("B2:B" & lRow)

    ws.Cells(ws.Rows.Count, "C").End(xlUp).Offset(1, 0).Value _
        = Application.WorksheetFunction.Aggregate(1, 6, irng)
    
    Dim FolderPath As String: FolderPath = ThisWorkbook.Path & "\Back_Up\"
    If Len(Dir(FolderPath, vbDirectory)) = 0 Then MkDir FolderPath
    
    ThisWorkbook.SaveCopyAs Filename:=FolderPath & "Bak-Up_" _
        & Format(Now, "yyyymmdd") & "_m" & ThisWorkbook.Name

    StartTimer

End Sub
  • Related