Macro getting stuck on average when no data is present

A

amphead

New Member
Joined
May 24, 2023
Messages
10
Office Version
  1. 365
Platform
  1. Windows
I've got a macro that i run that uses data from 3 locations. The problem is 1 of the locations does not have any data for this month. How can i get it to skip trying to run the average with no data? It stops when it can't do averages for a month with no data, I put that in bold text in the vba code.

Here is the what the data looks like when collection stopped. For November there is zero data for 2nd location.

rrea co 202311.xlsm
ABC
665005-Oct-2023 00:000.49
665105-Oct-2023 01:000.47
665205-Oct-2023 02:000.44
665305-Oct-2023 03:000.47
665405-Oct-2023 04:000.46
665505-Oct-2023 05:000.47
665605-Oct-2023 06:000.49
665705-Oct-2023 07:000.50.47375
665805-Oct-2023 08:000.5
665905-Oct-2023 09:000.43
666005-Oct-2023 10:000.43
666105-Oct-2023 11:000.42
666205-Oct-2023 12:000.41
666305-Oct-2023 13:000.4
666405-Oct-2023 14:000.42
666505-Oct-2023 15:000.420.42875
666605-Oct-2023 16:000.41
666705-Oct-2023 17:000.43
666805-Oct-2023 18:000.42
666905-Oct-2023 19:000.44
667005-Oct-2023 20:000.45
667105-Oct-2023 21:000.46
667205-Oct-2023 22:000.44
667305-Oct-2023 23:000.435714
667406-Oct-2023 00:000.45
667506-Oct-2023 01:000.39
667606-Oct-2023 02:000.43
667706-Oct-2023 03:000.42
667806-Oct-2023 04:000.42
667906-Oct-2023 05:000.42
668006-Oct-2023 06:000.44
668106-Oct-2023 07:000.50.43375
668206-Oct-2023 08:000.39
668306-Oct-2023 09:00
668406-Oct-2023 10:00
668506-Oct-2023 11:00
668606-Oct-2023 12:00
668706-Oct-2023 13:00
668806-Oct-2023 14:00
668906-Oct-2023 15:00
669006-Oct-2023 16:00
669106-Oct-2023 17:00
669206-Oct-2023 18:00
669306-Oct-2023 19:00
669406-Oct-2023 20:00
669506-Oct-2023 21:00
669606-Oct-2023 22:00
669706-Oct-2023 23:00
669807-Oct-2023 00:00
669907-Oct-2023 01:00
670007-Oct-2023 02:00
670107-Oct-2023 03:00
670207-Oct-2023 04:00
670307-Oct-2023 05:00
670407-Oct-2023 06:00
670507-Oct-2023 07:00
670607-Oct-2023 08:00
670707-Oct-2023 09:00
670807-Oct-2023 10:00
670907-Oct-2023 11:00
671007-Oct-2023 12:00
hahn co with macro


VBA Code: 
Sub stats()
Dim i, iday, iseg, istrt, istop, icnt, n, ntot, kstrthr, ktotdays, jj As Integer
Dim kmo, kk, itotdays, itothrs, icntgood, isite As Integer

Dim imo(12) As Integer
Dim tabnam As String


' get year from user

  kyr = InputBox("enter year (yyyy)")
  
'Cells(1, 13) = InputBox("enter year (yyyy)")
'kyr = Cells(1, 13)

' get month from user
  'Cells(1, 11) = InputBox("enter month (1 to 12)")
'kmo = Cells(1, 11)
  kmo = InputBox("enter month (01 to 12)")
  

imo(1) = 31: imo(2) = 28: imo(3) = 31: imo(4) = 30: imo(5) = 31: imo(6) = 30
imo(7) = 31: imo(8) = 31: imo(9) = 30: imo(10) = 31: imo(11) = 30: imo(12) = 31
If kyr Mod 4 = 0 Then imo(2) = 29
'Cells(20, 11) = imo(2)
mostr$ = "janfebmaraprmayjunjulaugsepoctnovdec"
' calc max hours in ytd
itotdays = 0
For kk = 1 To kmo
  itotdays = itotdays + imo(kk)
Next kk
itothrs = itotdays * 24
'Cells(2, 11) = kmo

' put raw data into wallace, hahnville, ama worksheet tabs
'wallace in column H (8), hahnville in col E (5), ama in col B (2)
' date in col A (1)
'calculate start hour

ktotdays = 0
If kmo = 1 Then
  kstrthr = 1
Else
  For kk = 1 To kmo - 1
    ktotdays = ktotdays + imo(kk)
  Next kk
    kstrthr = ktotdays * 24 + 1
End If

' copy from raw worksheet to wallace, ama, hahnville worksheets

jj = 4
For kk = kstrthr To itothrs
  Worksheets("wall co with macro").Cells(kk + 1, 1) = Worksheets("raw").Cells(jj, 1)
  Worksheets("wall co with macro").Cells(kk + 1, 2) = Worksheets("raw").Cells(jj, 8)
  Worksheets("hahn co with macro").Cells(kk + 1, 1) = Worksheets("raw").Cells(jj, 1)
  Worksheets("hahn co with macro").Cells(kk + 1, 2) = Worksheets("raw").Cells(jj, 5)
  Worksheets("ama co with macro").Cells(kk + 1, 1) = Worksheets("raw").Cells(jj, 1)
  Worksheets("ama co with macro").Cells(kk + 1, 2) = Worksheets("raw").Cells(jj, 2)
  jj = jj + 1
Next kk

'-------------------------------------------------------

For isite = 1 To 3
  If isite = 1 Then
    tabnam = "wall co with macro"
  ElseIf isite = 2 Then
    tabnam = "hahn co with macro"
  Else
    tabnam = "ama co with macro"
End If

Sheets(tabnam).Select

Cells(1, 13) = kyr
Cells(1, 11) = kmo
asumtot = 0
ntot = 0

GoTo nxt

'-------------------------NOT USED---------------------------------
' calculate 3 hr averages
asumtot = 0: ntot = 0
For iday = 1 To itotdays
  For iseg = 1 To 3
    istrt = (iday - 1) * 24 + (iseg - 1) * 8 + 2
    istop = istrt + 7

    asum = 0
    For i = istrt To istop
      asum = asum + Cells(i, 2)
    Next i
    aver = asum / 8
    arange$ = "B" & istrt & ":" & "B" & istop
    Set arang = Range(arange$)
   
    icnt = Application.WorksheetFunction.Count(arang)
    
 

    If icnt > 2 Then
      Cells(istop, 3) = aver
    End If
  Next iseg
Next iday

'----------------------------END OF NOT USED----------------------

nxt:
  
  'GoTo fin
' calculate 8 hour averages
For iday = 1 To itotdays
  For iseg = 1 To 3
  
    istrt = (iday - 1) * 24 + (iseg - 1) * 8 + 2
    
    istop = istrt + 7
    asum = 0
    n = 0
    For i = istrt To istop
      arange$ = "B" & i
      Set arang = Range(arange$)
      icnt = Application.WorksheetFunction.Count(arang)
      If icnt = 1 Then
        asum = asum + Cells(i, 2)
        n = n + 1
        asumtot = asumtot + Cells(i, 2)
        ntot = ntot + 1
      End If
    
    Next i
    If n > 0 Then aver = asum / n
    If n > 5 Then
      Cells(istop, 3) = aver
    End If
  Next iseg
Next iday
    'Cells(10, 10) = "here"
    'GoTo fin

' calculate annual and monthly maxs and averages
  Cells(3, 7) = asumtot / ntot
  
  istrt = 2: istop = itothrs + 1
  'find max year
  arange$ = "B2" & ":" & "B" & istop
  Set arang = Range(arange$)
  mxyr = Application.WorksheetFunction.Large(arang, 1)
  Cells(4, 7) = mxyr
  ' find max 8 hr
  arange$ = "C2:C" & istop
  Set arang = Range(arange$)
  mx8hr = Application.WorksheetFunction.Large(arang, 1)
  Cells(5, 7) = mx8hr
  'find annual recovery
  arange$ = "B2:B" & istop
  Set arang = Range(arange$)
  icntgood = Application.WorksheetFunction.Count(arang)
  cntpct = icntgood / (itothrs) * 100
  Cells(6, 7) = cntpct
[B]  'compute month average
  istrt = istop - imo(kmo) * 24 + 1
  arange$ = "B" & istrt & ":B" & istop
  Set arang = Range(arange$)
  moavg = Application.WorksheetFunction.Average(arang)
  Cells(7, 7) = moavg[/B]
   ' compute monthly 1 hr max
  momax = Application.WorksheetFunction.Large(arang, 1)
  Cells(8, 7) = momax
   'compue monthly 2nd 1 hr max
  mo2max = Application.WorksheetFunction.Large(arang, 2)
  Cells(8, 8) = mo2max
   'compute max 8 hr for month
  arange$ = "C" & istrt & ":C" & istop
  Set arang = Range(arange$)
  mo8hrmax = Application.WorksheetFunction.Large(arang, 1)
  Cells(9, 7) = mo8hrmax
  'compute 2nd max 8 hr for month
  mo8hr2max = Application.WorksheetFunction.Large(arang, 2)
  Cells(9, 8) = mo8hr2max
  'compute monthly recovery
  arange$ = "B" & istrt & ":B" & istop
  
  
  'Cells(7, 20) = arange$
  Set arang = Range(arange$)
  icntgoodmo = Application.WorksheetFunction.Count(arang)
  cntpctmo = icntgoodmo / (imo(kmo) * 24) * 100
  Cells(10, 7) = cntpctmo
  
  
  'put month labels on workbook
  molbl$ = Mid$(mostr$, (kmo - 1) * 3 + 1, 3)
  labl$ = molbl$ & " average"
  Cells(7, 6) = labl$
  labl$ = molbl$ & " 1-max"
  Cells(8, 6) = labl$
  labl$ = molbl$ & " 8-max"
  Cells(9, 6) = labl$
  labl$ = molbl$ & " recovery"
  Cells(10, 6) = labl$
  'put in other labels
  Cells(3, 6) = "yr avg"
  Cells(4, 6) = "yr 1-max"
  Cells(5, 6) = "yr 8-max"
  Cells(6, 6) = "ann recovery"
  Cells(1, 10) = "month"
  Cells(1, 12) = "year"
  Cells(1, 3) = "8-hr"

Next isite

' print to summary page
Worksheets("macro summary").Cells(1, 13) = "month"
Worksheets("macro summary").Cells(1, 14) = kmo
Worksheets("macro summary").Cells(1, 15) = "year"
Worksheets("macro summary").Cells(1, 16) = kyr

fin:

End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
I'm assuming that when you get a month with no data and the code stops running, it produces a runtime error? Can you provide the specific error number and message? And which line?
 
Upvote 0
Run-time error '1004':
Unable to get the Average property of the WorksheetFunction class

It stops on: moavg = Application.WorksheetFunction.Average(arang)

VBA Code: 
 'compute month average
  istrt = istop - imo(kmo) * 24 + 1
  arange$ = "B" & istrt & ":B" & istop
  Set arang = Range(arange$)
  moavg = Application.WorksheetFunction.Average(arang)
  Cells(7, 7) = moavg
 
Upvote 0
Possibly something like this (not tested).
VBA Code: 
        '[B]
        'compute month average
        On Error Resume Next
        istrt = istop - imo(kmo) * 24 + 1
        arange$ = "B" & istrt & ":B" & istop
        Set arang = Range(arange$)
        On Error GoTo 0
        If arang Is Nothing Then
            MsgBox "No data found for month " & kmo, vbOKOnly Or vbCritical, "No Data Error"
            Exit Sub
        End If
        moavg = Application.WorksheetFunction.Average(arang)
        Cells(7, 7) = moavg
        '[/B]

If you are looking to have it do something other than exit, you'll have to describe it.
 
Upvote 0
This might be slightly more robust.
VBA Code: 
    '[B]
    Dim NoData As Boolean
    'compute month average
    On Error Resume Next
    istrt = istop - imo(kmo) * 24 + 1
    arange$ = "B" & istrt & ":B" & istop
    Set arang = Range(arange$)
    On Error GoTo 0
    
    NoData = arang Is Nothing
    NoData = NoData Or IsError(Application.Average(arang))
    
    If NoData Then
        MsgBox "No data found for month " & kmo, vbOKOnly Or vbCritical, "No Data Error"
        Exit Sub
    End If
    
    moavg = Application.Average(arang)
    Cells(7, 7) = moavg
    '[/B]
 
Upvote 0
Solution
Thanks rlv01, your second solution worked for me. I didn't want it to exit, but I just removed the Exit Sub line. It now shows my month average as #DIV/0!, which is fine. Just as long as it continues running the macro.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
VBA error on loop when no data to average
Replies
3
Views
491
Joe4
Joe4

Forum statistics

Threads
1,223,882
Messages
6,175,164
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top