Find 0's down a column and replace the Average of adjacent cells

[sdingman]

I would like to search a column for 0, when found, replace with the Average of the cell above and the cell below. I found a piece of code that will do what I want, but would like to find a way to incorporate that piece of code that does work into a Find and Replace. I don't want to have to loop through every cell.

Sub Replace_Value_w_Ave()

Dim rngLocal As Range   'Create the Range
    
    Set rngLocal = Union(ActiveCell.Offset(-1, 0).Resize(1, 1), ActiveCell.Offset(1, 0).Resize(1, 1))   'Set the Range value to be the cell before and the cell after
    rngAvg = WorksheetFunction.Average(rngLocal)    'Set the variable to the average of the 2 cells.
    ActiveCell.Value = rngAvg

End Sub

The above code works great if I pre-select a cell with a zero, and run this macro. My attempt to place this into a macro that includes the Find and Replace hasn't worked.

Sub TestAverageFormula()
'
'
'

Dim rngLocal As Range
    Set rngLocal = Union(ActiveCell.Offset(-1, 0).Resize(1, 1), ActiveCell.Offset(1, 0).Resize(1, 1))
    rngAvg = WorksheetFunction.Average(rngLocal)

    Columns("H:H").Select
    Selection.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Replace What:="0", Replacement:=rngAvg, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
        :=False, ReplaceFormat:=False
        Selection.FindNext(After:=ActiveCell).Activate
End Sub

Any Suggestions or ideas of another way, would be helpful.
Steve