Maximum 7 Day Average from data range

[Calv1]

Hi,

I have a problem that I can't find a solution for. I have a table that retrieves total production from a site on a given day. This ranges back 3 years.

What I want to be able to find is the maximum 7 day average throughout that period. Any suggestions on the best way to achieve this would be most appreciated. All moving averages I have found do not seem to work dynamically in the way required.

Example table:

Site	01/01/2021	02/01/2021	03/01/201	04/01/2021	05/01/2021	06/01/2021	07/01/2021	08/01/2021	09/01/2021	10/01/2021
Site 1	66	88	51	22	33	11	55	88	99	100
Site 2	55	55	25	12	14	18	20	26	28	30
Site 3	44	44	250	137	22	11	5	800	500	600

From this, I then have a separate table as such;

Site	Max 7 Day Average
Site 1
Site 2
Site 3

What I'd like to do is have a formula, or a macro, that works through the data row by row, calculates the 7 day averages and at the end of it gives me the maximum 7 day average.

Any help or suggestions would be most appreciated.

 

[offthelip]

for a vba solution try this:

Sub test()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))
' pick up column and b for the output colummn b gets over written
outarr = Range(Cells(1, 1), Cells(lastrow, 2))
sm = 0
mxsm = 0
For i = 2 To lastrow
 ' initial 7 days
    For jj = 2 To 8
     sm = sm + inarr(i, jj)
    Next jj
    mxsm = sm
    For j = 9 To lastcol
    ' add next  value and subtract oldest value
     sm = sm + inarr(i, j) - inarr(i, j - 7)
     If sm > mxsm Then
      mxsm = sm
'      Cells(i + 10, j) = mxsm
     End If
    Next j
outarr(i, 2) = mxsm/7
mxsm = 0
sm = 0
Next i
With Worksheets("Sheet2")
outarr(1, 2) = "Max 7 Day Average"
.Range(.Cells(1, 1), .Cells(lastrow, 2)) = outarr
End With
End Sub

 

[Calv1]

for a vba solution try this:

Sub test()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))
' pick up column and b for the output colummn b gets over written
outarr = Range(Cells(1, 1), Cells(lastrow, 2))
sm = 0
mxsm = 0
For i = 2 To lastrow
 ' initial 7 days
    For jj = 2 To 8
     sm = sm + inarr(i, jj)
    Next jj
    mxsm = sm
    For j = 9 To lastcol
    ' add next  value and subtract oldest value
     sm = sm + inarr(i, j) - inarr(i, j - 7)
     If sm > mxsm Then
      mxsm = sm
'      Cells(i + 10, j) = mxsm
     End If
    Next j
outarr(i, 2) = mxsm/7
mxsm = 0
sm = 0
Next i
With Worksheets("Sheet2")
outarr(1, 2) = "Max 7 Day Average"
.Range(.Cells(1, 1), .Cells(lastrow, 2)) = outarr
End With
End Sub

Absolutely perfect. Thanks very much for this. Just tested it and in the main it's working fine.

On some occasions the production data that is pulled through comes through as "No data" or a string as opposed to a number.

Would it be possible to amend the code so that in these instances the values are ignored and move on to the next set of 7 numbers?

 

[offthelip]

try this ( untested). I have just put a test in to check the values are numeric , if not they should exit the loop

Sub test2()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))
' pick up column and b for the output colummn b gets over written
outarr = Range(Cells(1, 1), Cells(lastrow, 2))
sm = 0
mxsm = 0
For i = 2 To lastrow
Numt = False
 ' initial 7 days
    For jj = 2 To 8
        If Not (IsNumeric(inarr(i, jj))) Then
             Numt = True
             Exit For
         Else
             sm = sm + inarr(i, jj)
         End If
    Next jj
    mxsm = sm
    For j = 9 To lastcol
      If Not (IsNumeric(inarr(i, j))) Or Numt Then Exit For
    ' add next  value and subtract oldest value
     sm = sm + inarr(i, j) - inarr(i, j - 7)
     If sm > mxsm Then
      mxsm = sm
'      Cells(i + 10, j) = mxsm
     End If
    Next j
outarr(i, 2) = mxsm / 7
mxsm = 0
sm = 0
Next i
With Worksheets("Sheet2")
outarr(1, 2) = "Max 7 Day Average"
.Range(.Cells(1, 1), .Cells(lastrow, 2)) = outarr
End With
End Sub

 

[Calv1]

Thanks f

try this ( untested). I have just put a test in to check the values are numeric , if not they should exit the loop

Sub test2()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))
' pick up column and b for the output colummn b gets over written
outarr = Range(Cells(1, 1), Cells(lastrow, 2))
sm = 0
mxsm = 0
For i = 2 To lastrow
Numt = False
 ' initial 7 days
    For jj = 2 To 8
        If Not (IsNumeric(inarr(i, jj))) Then
             Numt = True
             Exit For
         Else
             sm = sm + inarr(i, jj)
         End If
    Next jj
    mxsm = sm
    For j = 9 To lastcol
      If Not (IsNumeric(inarr(i, j))) Or Numt Then Exit For
    ' add next  value and subtract oldest value
     sm = sm + inarr(i, j) - inarr(i, j - 7)
     If sm > mxsm Then
      mxsm = sm
'      Cells(i + 10, j) = mxsm
     End If
    Next j
outarr(i, 2) = mxsm / 7
mxsm = 0
sm = 0
Next i
With Worksheets("Sheet2")
outarr(1, 2) = "Max 7 Day Average"
.Range(.Cells(1, 1), .Cells(lastrow, 2)) = outarr
End With
End Sub

Thanks for taking the time to reply. Unfortunately this doesn't seem to work where there are text values. I get results for those where it's all numbers but not the others. I've attached a small snippet of the data I'm working with in case it helps identify the issue.

Currently working through your code to see if I can work out where the issue is. It's close though. Also surprised at how fast it runs!

 

[offthelip]

that does make it rather more complicatd, try this, I hope I have got the logic correct:
(untested)

Sub test()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))
' pick up column and b for the output colummn b gets over written
outarr = Range(Cells(1, 1), Cells(lastrow, 2))
sm = 0
mxsm = 0
For i = 2 To lastrow
Vcnt = 0  ' Validity counter
 ' initial 7 days
    For jj = 2 To 8
     If Not (IsNumeric(inarr(i, jj))) Then
      Vcnt = 0
      sm = 0
     Else
      sm = sm + inarr(i, jj)
      Vcnt = Vcnt + 1
     End If
    Next jj
    If Vcnt >= 7 Then
      mxsm = sm
    End If
    For j = 9 To lastcol
     If Not (IsNumeric(inarr(i, j))) Then
       Vcnt = 0
       sm = 0
     Else
        Vcnt = Vcnt + 1
        If Vcnt < 7 Then
          sm = sm + inarr(i, j)
        ' add next  value and subtract oldest value
         Else
            sm = sm + inarr(i, j) - inarr(i, j - 7)
            If sm > mxsm Then
             mxsm = sm
            End If
    '      Cells(i + 10, j) = mxsm
         End If
     End If
    Next j
outarr(i, 2) = mxsm / 7
mxsm = 0
sm = 0
Next i
With Worksheets("Sheet2")
outarr(1, 2) = "Max 7 Day Average"
.Range(.Cells(1, 1), .Cells(lastrow, 2)) = outarr
End With
End Sub