Sub FillBlanks() ' Purpose : Fills blanks with value from the above cell Dim Response As Integer Dim oRng As Range Set oRng = Selection 'Check for Rangesize If RangeCheck = True Then MsgBox "You've selected an entire Row or Column." & vbCrLf & _ "Please select a section of a single column range to check.", _ vbCritical, "Range Too Large to Process" Else If Selection.Count = 1 Then MsgBox "You need to select the range you want to fill," & vbCrLf & _ "from first populated cell to the last empty cell", vbOKOnly, "Help from John" Else oRng.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" Response = MsgBox("The cells have been filled with formulas." & vbCrLf & _ "Do you wish to convert them to Values?", vbYesNo + vbQuestion, "Help from John") If Response = vbYes Then oRng.Copy oRng.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End If End If End If End Sub Private Function RangeCheck() RangeCheck = False 'Check for Rangesize-Used in MULTIPLE Macros If Selection.Columns.Count = ActiveSheet.Columns.Count Or _ Selection.Rows.Count = ActiveSheet.Rows.Count Then RangeCheck = True End If End Function