macro averages number above and below

[J-Chef-T]

Needing to set a macro that can create averages of the number directly above
and the number directly below. For example the spreadsheet would looke like
so.


2
avg of 2&3
3
4
avg of 4&5


help?

 

[Gary''s Student]

Select a cell and run:

Sub average_setter()
ad1 = ActiveCell.Offset(-1, 0).Address
ad2 = ActiveCell.Offset(1, 0).Address
s = ad1 & "," & ad2
ActiveCell.Formula = "=AVERAGE(" & s & ")"
End Sub

 

[J-Chef-T]

THANK YOU!
now is there away to apply that to a whole sheet without manually in putting
the macro every 2 cells?

 

[Gary''s Student]

O.K. Let's say we have a column of numbers. There are blanks in the column,
but each blank has a filled cell above it and below it. For example:

1
2

3
4
5
6

7
8

8
11

Say we want to modify the macro to find each of the "special" blanks in the
column and deposit the formula in it:

Sub average_setter()
ad1 = ActiveCell.Offset(-1, 0).Address
ad2 = ActiveCell.Offset(1, 0).Address
s = ad1 & "," & ad2
ActiveCell.Formula = "=AVERAGE(" & s & ")"
End Sub
Sub main()
n = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To n
If IsEmpty(Cells(i, "A").Value) Then
Cells(i, "A").Select
Call average_setter
End If
Next
End Sub

The main macro loops down column A, looking for empty cells. When it finds
an empty, it Selects the cell and calls the average_setter macro to deposit
the formula.

 

[Dave Peterson]

You could do it manually, too--well, if those cells that will contain the
averages are empty.

Select the range to inspect
Edit|goto|Special|blanks
Notice that only the cells getting the =average() formula are selected.
type this:
=average(
hit the uparrow, then the comma, then the down arrow.
Then hit the close parent )

Now hit ctrl-enter to fill the selection with that formula. Excel will adjust
the formula for each of the cells.

In code, it would look like:

Option Explicit
Sub testme()

Dim myRng As Range
Dim myBlanks As Range

With ActiveSheet
Set myRng = .Range("a1:h20") 'whatever???
Set myBlanks = Nothing
On Error Resume Next
Set myBlanks = myRng.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If myBlanks Is Nothing Then
MsgBox "no blanks!"
Else
myBlanks.FormulaR1C1 = "=AVERAGE(R[-1]C,R[1]C)"
End If
End With

End Sub