View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Need macro to check if cell is not blank & previous cell is blank,copy information from row above & paste

Did you try it manually? If it didn't work the way you wanted, then don't do
this!

How about looking in column F to find the last used row. Then fill every blank
cell in A2:E(lastrow) with a formula that points at the cell above.

The last portion converts all the formulas in A:E to values.

Option Explicit
Sub FillColBlanks()

Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long

Set wks = ActiveSheet

With wks
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row

Set rng = Nothing
On Error Resume Next
Set rng = .Range("A2:E" & LastRow).Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'convert A:E to values???
With .Range("A2:E" & LastRow)
.Value = .Value
End With

End With

End Sub

JenIT wrote:

Hi Dave:

Thanks for the prompt response. I must have this all work within a
macro - so coding is what I am after. And by looking at the link I
believe there is a lot for me to use in your coding however I am
coming up short because of my inexperience with this. I must replace
the blanks yet to be careful not to replace the number in col F as
that can be a variable.

I used below - When I try use this line...col
= .range("A2:E3000").column - it replaces Col A only (my sheet will
always vary in length) And if I use it with active cells only...it
will replace the blanks in the first column as well and nothing else.
No matter what critera I use it does always break at .value
= .value THOUGHTS??

Sub FillColBlanks()
'by Dave Peterson 2004-01-06
'fill blank cells in column with value above
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim col As Long

Set wks = ActiveSheet
With wks
col = activecell.column
'or
'col = .range("b1").column

Set rng = .UsedRange 'try to reset the lastcell
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set rng = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, col).EntireColumn
.Value = .Value
End With

End With

End Sub


--

Dave Peterson