Tricky average per every x values. Excel

[Stoffel24]

This is a tricky one! On sheet1, I have a column with dates and another column with values:
ie Date Values
1/07/02 23
1/07/02 20
1/07/02 12
2/07/02 25
3/07/02 19
3/07/02 19

On sheet2!B1, I have a cell where the user enters in the number of values required before working out the average. Eg 3 means we would work out the average of 23, 20 and 12, then 25, 19 and 19 etc. 2 means we only work out the average of 23 and 20, then 25 and 19 and so on. The result of this would be plugged into cell Sheet2! B3, B4 etc. In cell Sheet2!A3, A4 etc would go the date of the 1st value used to work out the average. ie if we work out the average every 2nd value, sheet2 would look something like this:

2
Date Average
1/07/02 21.5
1/07/02 18.5
3/07/02 19

This would be done until there are no more values left on sheet1 with which to calculate an average with.

I am fiddling around trying to do it myself but I am getting nowhere fast. Any help would be appreciated! Thanks.

 

[dwilson01]

This looks like it works, check it out.

Sub TrickySum()

Dim NSum As Integer, MyRange As Range, MyAverage As Double

Application.ScreenUpdating = False
Sheets(1).Activate
'Set user input
NSum = Sheets(2).Cells(1, 2)
i = 2: j = 3
Do
'Date
Sheets(2).Cells(j, 1) = Sheets(1).Cells(i, 1)
'Average
Set MyRange = Range(Sheets(1).Cells(i, 2).Address _
& ":" & Sheets(1).Cells(i + NSum - 1, 2).Address)
Sheets(2).Cells(j, 2) = Sheets(1).Application.WorksheetFunction.Average(MyRange)
'Index Variables
j = j + 1
i = i + NSum
Loop While Not Len(ActiveWorkbook.Sheets(1).Cells(i, 2)) = 0
Sheets(2).Activate
Application.ScreenUpdating = True

End Sub

The only thing I cannot get it to do is update the averages when the user input changes, you have to run the macro manually. Maybe you can start with this and make it work for your application. Also, this assumes the number of data points to average is in Sheets(2).Cells(1,2). Let me know if there is something else that you need.

Dave

 

[xlbo]

Making it work when the input changes is the bit I can help with
Put the code in the worksheet_Change event

and precede it with

If target.address <> &quot;$B$1&quot;
exit sub
Else
End If

HTH
~Geoff~

 

[dwilson01]

Thanks for the input Geoff, however, I tried this and for some reason, unknown to me, the Application.WorksheetFunction does not work when put in the Worksheet_Change event. I'm not sure why, do you know? I'm pretty sure it is something to do with the fact that we are averaging from sheet 1 and using the change event of sheet 2.

 

[xlbo]

Try this then - bit of judicious changing of the range name to incorporate the woprrksheet name

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim NSum As Integer, MyRange As Range, MyAverage As Double

If Target.Address <> &quot;$B$1&quot; Then
Exit Sub
Else
End If

Application.ScreenUpdating = False
Sheets(1).Activate
'Set user input
NSum = Sheets(2).Cells(1, 2)
i = 2: j = 3
Do
'Date
Sheets(2).Cells(j, 1) = Sheets(1).Cells(i, 1)
'Average
Set MyRange = Sheets(1).Range(Cells(i, 2).Address _
& &quot;:&quot; & Sheets(1).Cells(i + NSum - 1, 2).Address)
Sheets(2).Cells(j, 2) = Application.WorksheetFunction.Average(MyRange)
'Index Variables
j = j + 1
i = i + NSum
Loop While Not Len(ActiveWorkbook.Sheets(1).Cells(i, 2)) = 0
Sheets(2).Activate
Application.ScreenUpdating = True
End Sub

HTH
~Geoff~