Solved: Rolling average

[Northender]

I was hoping somebody would be able to help me get started on converting some excel formula into VBA. I have a spreadsheet that is updated from various other workbooks with usage data on a daily basis. This is done via a vba button. What I would like is for this button to also update the moving average for each line. I have wrote the formula for this, but would really like to consolidate into one cell that is updated for each line. Problem is I dont know where to start to convert this.

Please see attached sample sheet

Thanks

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "2:10" '<== change to suit
Dim mpSummary As Long
Dim mpLastRow As Long
Dim mpDataCol As Long
Dim mpSum As Double
Dim mpCount As Long
Dim i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Column > 3 Then
mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
On Error Resume Next
mpSummary = Application.Match(Me.Cells(.Row, "A"), Me.Range("A14:A" & mpLastRow), 0)
On Error GoTo 0
If mpSummary = 0 Then
mpSummary = mpLastRow + 1
Me.Rows(mpSummary).Insert
Me.Cells(mpSummary, "A").Value = Me.Cells(.Row, "A").Value
With Me.Range("B" & mpSummary).Resize(1, 6)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
With Me.Range("B" & mpSummary)
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
mpSummary = mpSummary - 13
End If
mpDataCol = Me.Range("A" & .Row).End(xlToRight).Column
Me.Cells(mpSummary + 13, "B").Value = mpDataCol - 3
If mpDataCol - 4 < 4 Then mpDataCol = 8
mpSum = 0: mpCount = 0
For i = 1 To 5
Me.Cells(mpSummary + 13, i + 2).Value = Me.Cells(.Row, mpDataCol - i + 1).Value
mpSum = mpSum + Me.Cells(.Row, mpDataCol - i + 1).Value
If Me.Cells(.Row, mpDataCol - i + 1).Value > 0 Then mpCount = mpCount + 1
Next i
Me.Cells(mpSummary + 13, "I").Value = Round(mpSum / mpCount, 0)
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Private Sub Latest5(RowNum As Long)

End Sub


This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.

[Northender]

xld,

Thankyou for your reply. Unfortunately I may not have made myself clear enough in my original post, for this I apologize. I have tried to work through your code to extract what I need to make it work but dont seem to be able to do this correctly. To clarify what it is I am trying to do.

In my sheet that I attached I have information that runs in rows 2 to 10 and along columns D to AI. This is updated by pressing a button and being extracted from various workbooks. What I then want to happen is for AJ to be updated with the average from the last five days figures ( >0 ). I know the formulas to do this, as layed out in the lower section. I dont want to place all these columns at the end to do the calculations, rather a code to carry out the calculation and then drop the answer in. Ideally I want to place this code at the end of the extraction process.

I apologize if I have wasted your time with this, although I have learned a bit from reading the code, just seems not quite enough to solve the problem.

[Bob Phillips]

Public Sub ProcessData()
Dim mpLastRow As Long
Dim mpDataCol As Long
Dim mpSum As Double
Dim mpCount As Long
Dim i As Long, j As Long


With ActiveSheet

mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For i = 2 To mpLastRow

If .Cells(i, "D").Value <> "" Then
mpDataCol = .Range("A" & i).End(xlToRight).Column
.Cells(i, "AJ").Value = mpDataCol - 3
If mpDataCol - 4 < 4 Then mpDataCol = 8
mpSum = 0: mpCount = 0
For j = 1 To 5
.Cells(i, 36 + j).Value = .Cells(i, mpDataCol - j + 1).Value
mpSum = mpSum + .Cells(i, mpDataCol - j + 1).Value
If .Cells(i, mpDataCol - j + 1).Value > 0 Then mpCount = mpCount + 1
Next j
.Cells(i, "AP").Value = Round(mpSum / mpCount, 0)
End If
Next i
.Range("AJ2:AO" & mpLastRow).BorderAround Weight:=xlThin
.Range("AJ2:AJ" & mpLastRow).BorderAround Weight:=xlThin

End With

End Sub

[Northender]

Thanks for your help with this, hopefully just one more question...

Next j
.Cells(i, "AP").Value = Round(mpSum / mpCount, 0)
End If

Can you just help with if this is an error. I have just come across a line with all zero's in, which causes an overflow error in the script.

[Bob Phillips]

Replace that line with



If mpCount = 0 Then
.Cells(i, "AP").Value = 0
Else
.Cells(i, "AP").Value = Round(mpSum / mpCount, 0)
End If

[Northender]

:bow: Thanks for your help with is, much appreciated</IMG>