Vba to find first empty cell and average the 4 cells above it and paste value in another cell

Question

Hi I am having trouble with my vba code. I would like it to search the thirteenth column (column M) until it finds a blank cell. In that blank cell take an average of the 4 cells above it. Then take that value and paste it in cell D86. Then do the same thing; go to column M find first empty cell, in that first empty cell now take the average of 8 cells above it and paste that value into D87. Same thing but then 13 cells up and paste into D88. If anyone can help me with this I would be more than grateful, for some reason I cannot figure it out. Thanks, if you need anythiing else just ask.

Start the macro record and do exactly what you described - ideally with the keyboard (e.g. Ctrl-Down to find the next blank cell, shift arrows to select a range, etc.). Then take a look at the produced macro and modify it to your needs. If you get stuck, show us the code and we'll help further! — Peter Albert

Chrismas007 Chrismas007 · Accepted Answer · 2015-01-21T22:31:05

My Solution (removed from original post):

Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim FormulaWriter As String
Dim currentRowValue As String
Dim Thirteenback As Integer
Dim Eightback As Integer
Dim Fourback As Integer
Dim Oneback As Integer
Dim EndCol As Integer
    sourceCol = 3   'column C has a value of 3
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    'for every row, find the first blank cell and select it
    For currentRow = 2 To rowCount
        currentRowValue = Cells(currentRow, sourceCol).Value
        If IsEmpty(currentRowValue) Or currentRowValue = "" Then
        Cells(currentRow, sourceCol).Select
            Exit For
        End If
    Next
    Thirteenback = currentRow - 13
    Eightback = currentRow - 8
    Fourback = currentRow - 4
    Oneback = currentRow - 1
If Fourback < 4 Then
                Range("D86") = "=IFERROR(AVERAGE(M4" + ":" + "M7), 0)"
            Else
                FormulaWriter = "=IFERROR(AVERAGE(M" + CStr(Fourback) + ":" + "M" + CStr(Oneback) + "), 0)"
                Range("D86") = FormulaWriter
End If
If Eightback < 8 Then
                Range("D87") = "=IFERROR(AVERAGE(M4" + ":" + "M11), 0)"
              Else
                FormulaWriter = "=IFERROR(AVERAGE(M" + CStr(Eightback) + ":" + "M" + CStr(Oneback) + "), 0)"
                Range("D87") = FormulaWriter
End If
If Thirteenback < 13 Then
                Range("D88") = "=IFERROR(AVERAGE(M4" + ":" + "M16), 0)"
            Else
                FormulaWriter = "=IFERROR(AVERAGE(M" + CStr(Thirteenback) + ":" + "M" + CStr(Oneback) + "), 0)"
                Range("D88") = FormulaWriter
End If
Range("D86:D88").Select
Selection.AutoFill Destination:=Range("D86:E88"), Type:=xlFillDefault
End Sub

Vba to find first empty cell and average the 4 cells above it and paste value in another cell

1 Answers