If you don't want to select or fill 3000 names, try this
ActiveCell.Offset(1, 0).Activate
???
======
"Bradley Dawson" wrote in message
...
If you don't want to select or fill 3000 names, try this:

Sub dptnum()
Dim i%
i = 1
Do While Not (IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0)))
If Not IsEmpty(ActiveCell) Then
ActiveCell.Offset(0, -1) = i
Else
i = i + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub

Start at the top of the list with a blank column to the left of the list.
It will stop when two blank rows are encountered.

"Tom" wrote
I have the following scenario
One column in excel contains more than 3000 names
I want to fill the adjacents cells with Department Number
Fortunately all the names belonging to same department are
coming together followed by an EMPTY CELL Then the second
Department names start followed by an EMPTY CELL then
third Department names being and so on "all these under
one column"
I need to tell Excel to start filling the adjacent cell of
Dept1 names with Number 1 and continue down stream
Till it found the adjacent cell is EMPTY (in our example
the cell between Tom and James) Stop filling and Jump to
next cell and start filling with number 2 till it found
the second Empty cell stop
filling and Jump to adjacent cell and start
filling with number 3 and so on....