number cells within a range

[Guest]

I wish to select a cell and then sequencially number it (starting at 20) and
all cells, in the same column, beneath it until either there is an entry in
the cell or column A is empty. Is this possible?
Thanks

 

[Incidental]

Hi PeteN

You could do it with the code below it would need to be set to
something to run like a button or you could have the worksheet change
event call it as a sub when you click on a blank cell in column B or
something.

Option Explicit
Dim FstCell, LstCell As String
Dim SeqAdd As Integer
Dim MyCell, MyRng As Range

Private Sub CommandButton1_Click()

FstCell = ActiveCell.Address

LstCell = ActiveCell.End(xlDown).Offset(-1, 0).Address

SeqAdd = 20

Set MyRng = Range(FstCell, LstCell)

For Each MyCell In MyRng

If MyCell.Offset(0, -1).Value <> "" Then

MyCell.Value = SeqAdd

SeqAdd = SeqAdd + 1
Else

Exit Sub

End If

Next MyCell

End Sub

Hope this is of some help to you

S

 

[NickHK]

Here's one way:

Private Sub CommandButton2_Click()
Dim Cell As Range
Dim ProcessRange As Range
Dim i As Long

Const STARTVAL As Long = 20 - 1

Set ProcessRange = Range(ActiveCell, ActiveCell.End(xlDown))
i = 1
Do Until Range("A" & ProcessRange(i).Row).Value = ""
ProcessRange(i).Value = STARTVAL + i
i = i + 1
Loop

End Sub

NickHK

 

[Guest]

Thanks Nick for your help.
The routine runs but does not stop if there is an entry in the column, only
when column A is blank, therefore overwriting entries. What can I do to stop
this?

 

[NickHK]

OK, try this:

Private Sub CommandButton1_Click()
Dim Cell As Range
Dim i As Long

Const STARTVAL As Long = 20

For Each Cell In Range(ActiveCell, ActiveCell.End(xlDown).Offset(-1, 0))
If Range("A" & Cell.Row).Value = "" Then Exit For
Cell.Value = STARTVAL + i
i = i + 1
Next

End Sub

Or if you have a lot of cells to fill, this avoids a time consuming loop.
<Briefly tested>

Private Sub CommandButton1_Click()
Dim LastRowInActiveCol As Long
Dim LastRowInACol As Long
Dim FillRange As Range

Const STARTVAL As Long = 20

LastRowInActiveCol = ActiveCell.End(xlDown).Offset(-1, 0).Row
LastRowInACol = Range("A" & ActiveCell.Row).End(xlDown).Row

If LastRowInActiveCol > LastRowInACol Then
Set FillRange = Range(ActiveCell, ActiveCell.Offset(LastRowInACol -
ActiveCell.Row, 0))
Else
Set FillRange = Range(ActiveCell, ActiveCell.Offset(LastRowInActiveCol -
ActiveCell.Row, 0))
End If

FillRange.FormulaR1C1 = "=R[-1]C+1"
FillRange(1, 1).Value = STARTVAL

End Sub

NickHK

 

[Guest]

Thanks Nick, worked a treat!

OK, try this:

Private Sub CommandButton1_Click()
Dim Cell As Range
Dim i As Long

Const STARTVAL As Long = 20

For Each Cell In Range(ActiveCell, ActiveCell.End(xlDown).Offset(-1, 0))
If Range("A" & Cell.Row).Value = "" Then Exit For
Cell.Value = STARTVAL + i
i = i + 1
Next

End Sub

Or if you have a lot of cells to fill, this avoids a time consuming loop.
<Briefly tested>

Private Sub CommandButton1_Click()
Dim LastRowInActiveCol As Long
Dim LastRowInACol As Long
Dim FillRange As Range

Const STARTVAL As Long = 20

LastRowInActiveCol = ActiveCell.End(xlDown).Offset(-1, 0).Row
LastRowInACol = Range("A" & ActiveCell.Row).End(xlDown).Row

If LastRowInActiveCol > LastRowInACol Then
Set FillRange = Range(ActiveCell, ActiveCell.Offset(LastRowInACol -
ActiveCell.Row, 0))
Else
Set FillRange = Range(ActiveCell, ActiveCell.Offset(LastRowInActiveCol -
ActiveCell.Row, 0))
End If

FillRange.FormulaR1C1 = "=R[-1]C+1"
FillRange(1, 1).Value = STARTVAL

End Sub

NickHK

Thanks Nick for your help.
The routine runs but does not stop if there is an entry in the column, only
when column A is blank, therefore overwriting entries. What can I do to stop
this?