M
Max
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: B33, 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
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: B33, 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