try this

Sub filldepts()
dept = 1
For Each c In Selection
If c < "" Then c.Offset(, -1) = dept
If c = "" Then dept = dept + 1
Next
End Sub

"Tom" wrote in message
...
I have the following scenario
One column in excel contains more than 3000 names
i.e.
Jack
Adam
Tom

James
DJ
Wendy
Haris
keen

Anthony
The names belong to different departments I will called
Dept 1, 2, 3 ,.......25
I want to fill the adjacents cells with Department
Number i.e.
1 Jack
1 Adam
1 Tom

2 James
2 DJ
2 Wendy
2 Hars
2 keen

3 Anthony
3 David

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 (between Keen and Anthony)stop
filling and Jump to Anthony's adjacent cell and start
filling with number 3 and so on....
This will be a great help and will save me a great deal of
time thank in Advance even if you read till here