Copy data from above rows in cells are blank

[Guest]

Hi,

Wonder if someone can help me please.

I have quite a hefty amount of information in a spreadsheet, ranging from
columns A to I, rows 2 to 30,000, with column names in row 1.

Within this spreadsheet there are rows which have missing data. Can anyone
tell me please how I would go about developing a macro that when it come
across a blank row it copies the data from the above row and pastes it in the
blank row.

Many thanks

Chris

 

[Guest]

There is a fairly simple trick to doing this...

1. Find one of the empty cells and in that cell (For example A10) add the
formula to make it equal to the cell above (son in my example the formula in
A10 would be =A9)
2. Copy the cell where you have just added the formula.
3. Select the entire range A1:I30000
4. Hit F5 (or Ctrl+G) to bring up the Goto dialog
5. Click on the Special button
6. Select Blank Cells
7. All of the blank cells will now be highlighted.
8. Now paste the formula that you copied. (ctrl + V)
9. You may want to paste special values if you intend to resort the sheet.

 

[acampbell012]

Modify the range as needed. I have the "On Error..." to prevent
crashing when a blank is encountered in the offset cell. Maybe somebody
can help work around this if it causes problems.

Sub SameAsAbove()
'Copies data from cell above if current cell in range is blank
Dim MyRange As Range
Dim MyCell As Range
Dim Endrow As Integer
Endrow = Range("A65536").End(xlUp).Row
Set MyRange = Range("A1:G" & Endrow)
MyRange.Select
On Error Resume Next
For Each MyCell In MyRange
If MyCell.Value = "" Then
MyCell.Value = MyCell.Offset(-1, 0).Value
End If
Next MyCell
End Sub

 

[acampbell012]

Modify the range as needed. I have the "On Error..." to prevent
crashing when a blank is encountered in the offset cell. Maybe somebody
can help work around this if it causes problems.

Sub SameAsAbove()
'Copies data from cell above if current cell in range is blank
Dim MyRange As Range
Dim MyCell As Range
Dim Endrow As Integer
Endrow = Range("A65536").End(xlUp).Row
Set MyRange = Range("A1:G" & Endrow)
MyRange.Select
On Error Resume Next
For Each MyCell In MyRange
If MyCell.Value = "" Then
MyCell.Value = MyCell.Offset(-1, 0).Value
End If
Next MyCell
End Sub

 

[Guest]

Thanks for taking the time to read this.

I've used it on some test data and it works a treat.

Thanks again

Chris

 

[Guest]

Jim,

Thanks for this. Even after using Excel for so long, it's amazing how much
you can still learn. This may also help me with something else I'm working
on.

Once again many thanks

Chris