Seeking 2 enhancements to the Sub FillColBlanks() by Dave Peterson (pasted
below for easy reference)

1. Would like the flexibility to "select" either:
(a) a continuous multi-col range with the mouse, say: B3:E3, or
(b) a discontiguous multi-col range say: B3:D3, G3, K3
and then just run the sub once to work on the multi-col range

2. Any text numbers filled down the col(s) should not change to real
numbers. The original format to be retained.

Thanks for insights.

Rgds
Max
--------------- ------
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

I'm not sure what you want since you only select one row in each of your
examples. I think I'd select the whole range that I want fixed.

I don't know how to determine the last cell that should be filled--is it the
last used cell in the worksheet, or the last used cell in the column or the last
used row in any column.

I'm gonna guess that it's the last one--and I used column A to find that last
used row (how far to fill).

Option Explicit
Sub FillColBlanks2()

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

Set wks = ActiveSheet

Set myRng = Selection

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

For Each myArea In myRng.Areas
Set rng = Nothing
On Error Resume Next
Set rng = .Range(myArea, _
Intersect(myArea.EntireColumn, .Rows(LastRow))) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found in area: " & myArea.Address
Else
rng.FormulaR1C1 = "=R[-1]C"
With myArea
.Value = .Value
End With
End If
Next myArea
End With

End Sub

This actually does the filling on an area by area basis--not column by column.





Max wrote:

Seeking 2 enhancements to the Sub FillColBlanks() by Dave Peterson (pasted
below for easy reference)

1. Would like the flexibility to "select" either:
(a) a continuous multi-col range with the mouse, say: B3:E3, or
(b) a discontiguous multi-col range say: B3:D3, G3, K3
and then just run the sub once to work on the multi-col range

2. Any text numbers filled down the col(s) should not change to real
numbers. The original format to be retained.

Thanks for insights.

Rgds
Max
--------------- ------
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

Thanks, Dave. It works well. Just a fine point. Could the formulas inserted
by the sub be removed at end of run?

Rgds
Max

I would have guessed that this changed everything to values:

With myArea
.Value = .Value
End With

You sure it didn't?

If there were no empty cells in any area, then the existing formulas stayed
formulas.

maybe you want???

If rng Is Nothing Then
MsgBox "No blanks found in area: " & myArea.Address
Else
rng.FormulaR1C1 = "=R[-1]C"
end if

With myArea
.Value = .Value
End With


Max wrote:

Thanks, Dave. It works well. Just a fine point. Could the formulas inserted
by the sub be removed at end of run?

Rgds
Max

--

Dave Peterson

Dave, thanks for the response, It's ok. I'll stick with your earlier
revision, and do a copy n paste special as values to kill the formulas.

Rgds
Max

You've got me confused.

Are you writing that the .value = .value line didn't work?

Max wrote:

Dave, thanks for the response, It's ok. I'll stick with your earlier
revision, and do a copy n paste special as values to kill the formulas.

Rgds
Max

--

Dave Peterson