setting cell to equal cell below

[Todd77]

Hi all,

I have blank rows in a table that I want to have equal the row below. The idea is that, while cells immediately below might also be blank, we will eventually hit a row that isn't blank and the formerly blank cells would take those values.

I used the macro recorder to get a sense of how to write the code. However, it only gives specific cell references. Can anyone help?

Todd77

 

[jmacleary]

Hi there. This code looks upwards in column A and if any blank is found, the row below (either just column A or the whole row depending on which line you leave in of my 2 commented lines) is copied into the row above. I wasn't quite sure if you want the cell or the row copied.

Sub fillup()
Dim FromRow As Long
Dim ThisRow As Long
' column A assumed to look for blanks
With ActiveSheet
    FromRow = .Range("A65536").End(xlUp).Row
' works from the last row with data in column A to row 1 (stepping backwards)
    For ThisRow = FromRow To 1 Step -1
        If .Range("A" & ThisRow).Value = "" Then
        
            Range("A" & ThisRow).Value = Range("A" & ThisRow + 1).Value  ' use this line if you only want column A value

            .Rows(ThisRow).EntireRow.Value = .Rows(ThisRow + 1).EntireRow.Value   ' use this line if you want the whole row
            
        End If
    Next ThisRow
End With
End Sub

 

[mohadin]

Hi
Or may be

Sub fill_empty()
    lr = ActiveSheet.UsedRange.Rows.Count
    lc = ActiveSheet.UsedRange.Columns.Count
    x = Range("a1:a" & lr).SpecialCells(xlCellTypeBlanks).Address
    x = Split(x, ",")
    For i = 0 To UBound(x)
        Range(x(i)).Offset(-1).Resize(, lc).Copy ActiveSheet.Range(x(i)).Resize(, lc)
    Next
End Sub

 

[Peter_SSs]

If the column does not already contain formulas that need to be retained, then try

Sub Fill_Blanks()
  With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .SpecialCells(xlBlanks).FormulaR1C1 = "=R[1]C"
    .Value = .Value
  End With
End Sub

 

[mohadin]

I think this

Sub fill_empty()
Set ws = ActiveSheet
    lr = ws.UsedRange.Rows.Count
    lc = ws.UsedRange.Columns.Count
    x = Range("a1:a" & lr).SpecialCells(xlCellTypeBlanks).Address
    x = Split(x, ",")
    For i = 0 To UBound(x)
        ws.Range(x(i)).Offset(-1).Resize(, lc).Copy ws.Range(x(i)).Resize(, lc)
    Next
     ws.Range(x(i - 1)).Offset(1).Resize(, lc).Copy ws.Range(x(i - 1)).Offset(2).Resize(, lc)
End Sub

 

[Todd77]

Hi all,

Thanks for the help.

Todd