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

**sdingman** · 07-12-2017, 12:53 PM

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

**xladept** · 07-12-2017, 01:29 PM

Try this:

Sub TestAverageFormula(): Dim F As Range
Dim rngLocal As Range, rngAvg As Single
    
    Set F = Range("H:H").Find(0)
    
    Do
    If Not F Is Nothing Then
    
Set rngLocal = Union(F.Offset(-1, 0).Resize(1, 1), F.Offset(1, 0).Resize(1, 1))
                rngAvg = WorksheetFunction.Average(rngLocal)
    
    F.Replace 0, rngAvg
        Set F = Range("H:H").FindNext(F)
    End If:    Loop While Not F Is Nothing
End Sub

**sdingman** · 07-12-2017, 02:52 PM

xladept, Thank you very much.
Your code works but is working on cells with leading zeros. Many of the values in column H are below 1 decimal values with leading zero's, so it is returning some strange results. I need this to only work on cells that only have a single zero, and return values of like kind, single decimal place values.

**mehmetcik** · 07-12-2017, 02:17 PM

Try this:

Replace the zeros with =Memo()

The Memo function will do the heavy work for you.


Sub Macro5()
    Columns("B:B").Replace What:="0", Replacement:="=memo()", LookAt:=xlWhole
End Sub


Function Memo()

If Application.Caller.Row > 1 Then

A = Application.Caller.Offset(-1, 0)
Else
A = 0
End If

Memo = (A + Application.Caller.Offset(1, 0)) / 2

End Function

**sdingman** · 07-12-2017, 03:27 PM

mehmetcik, Works great, and very, very fast. Thank You
Steve

**xladept** · 07-12-2017, 02:56 PM

Oops

Sub TestAverageFormula(): Dim F As Range
Dim rngLocal As Range, rngAvg As Single
    
    Set F = Range("H:H").Find(0, lookat:=xlWhole)
    
    Do
    If Not F Is Nothing Then
    
Set rngLocal = Union(F.Offset(-1, 0).Resize(1, 1), F.Offset(1, 0).Resize(1, 1))
                rngAvg = WorksheetFunction.Average(rngLocal)    
                                                                              F.Value=rngAvg
        Set F = Range("H:H").FindNext(F)
    End If:    Loop While Not F Is Nothing
End Sub

**xladept** · 07-12-2017, 03:41 PM

You're welcome and thanks for the rep!

*I modified the code.

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

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

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

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

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

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

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

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

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

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Average column if adjacent cells are between a specific number range

Looping 'find' to find a value and replace a value in an adjacent column

Macro to find all specific values in column and replace adjacent cell values

Average range of cells in column if values in adjacent column are equal

Find and replace based on adjacent cells?

Find multiple words and replace the adjacent column with one word

Average non-adjacent cells in column

Bookmarks

Bookmarks

Posting Permissions