Enhancements to Sub FillColBlanks by Dave Peterson

[Guest]

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

 

[Dave Peterson]

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.

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

 

[Guest]

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]

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]

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]

You've got me confused.

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

 

[Max]

Are you writing that the .value = .value line didn't work?
yes, somehow there's still residual formulas ..

Rgds
Max

 

[Max]

It's probably in the way I run your sub, Dave, which suits my purposes. I
select only a single cell within the cols, just below the col header(s) (to
be filled), then I run it. Where I select (those few cells), there's no
formulas post run, but the text numbers get converted to real numbers (I'd
reinstate these few cells manually - no prob). The formulas appear in the
rows below, where the sub fills it in, but w/o converting the text numbers
to real numbers, which is what I wanted.

Rgds
Max

 

[Dave Peterson]

Ahhh. I see.

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

I was changing the original selection--not the "extended" range (through the
lastrow).

 

[Max]

Dave, thanks. Tried your latest suggestion but it didn't work out, things
got messed up instead (although there's no more residual formulas anywhere).

Pre-run example (all numbers indicated are text numbers)

88
< I selected this cell, then ran the sub
89



090



Total

Result:

88
88
89
88
88
88
090
88
88
88
Total


But when I revert to using the sub in your 1st response, I got:

88
88
89
89
89
89
090
090
090
090
Total


which is more what I want (ie retention of original text numbers in the fill
down), albeit there are residual formulas. The only cell that got converted
to real number was the single cell I selected when I run the sub. I would
just reinstate this single cell to a text number.

Rgds
Max

 

[Dave Peterson]

Sigh. Yep.

Since rng could be multiarea, that won't work.

with Intersect(myArea.EntireColumn, .Rows(LastRow))
.value = .value
end with

Should be the next thing that you try.

If you see your text numbers change to number numbers, try:

with Intersect(myArea.EntireColumn, .Rows(LastRow))
.copy
.pastespecial paste:=xlpastevalues
end with

 

[Max]

This amendment worked well for me, Dave.

with Intersect(myArea.EntireColumn, .Rows(LastRow))
.value = .value
end with

Many thanks, and for your patience, too!

Max

 

[Dave Peterson]

Whew!
<bg>

This amendment worked well for me, Dave.


Many thanks, and for your patience, too!

Max