This macros shares them out

Sub Test()
Const nPosties As Long = 8
Dim aryColours
Dim iLastRow As Long
Dim cSharedAddresses As Long
Dim cAddresses As Long
Dim cSpread As Long
Dim iColour As Long
Dim i As Long

aryColours = Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
xlCILightBlue, _
xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
xlCIPeriwinkle, xlCIPlum)
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
cSharedAddresses = Int((iLastRow - 2) / nPosties)
cAddresses = cSharedAddresses
cSpread = nPosties - (iLastRow - 2 - cAddresses * nPosties)
iColour = 1
For i = 3 To iLastRow
Cells(i, "A").Resize(, 6).Interior.ColorIndex = aryColours(iColour -
1)
If (i - 2) Mod cAddresses = 0 Then
iColour = iColour + 1
If iColour nPosties Then
iColour = nPosties
End If
End If
If cSpread = iColour And cAddresses = cSharedAddresses Then
cAddresses = cAddresses + 1
End If
Next i

End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Bob Phillips" wrote in message
...
All the extra ones go to the last guy with this code <g

Public Enum xlColorIndex
xlCIBlack = 1
xlCIWhite = 2
xlCIRed = 3
xlCIBrightGreen = 4
xlCIBlue = 5
xlCIYellow = 6
xlCIPink = 7
xlCITurquoise = 8
xlCIDarkRed = 9
xlCIGreen = 10
xlCIDarkBlue = 11
xlCIDarkYellow = 12
xlCIViolet = 13
xlCITeal = 14
xlCIGray25 = 15
xlCIGray50 = 16
xlCIPeriwinkle = 17
xlCIPlum = 18
xlCIIvory = 19
xlCILightTurquoise = 20
xlCIDarkPurple = 21
xlCIcoral = 22
xlCIOceanBlue = 23
xlCIIceBlue = 24
'xlCIDarkBlue = 25
'xlCIPink = 26
'xlCIYellow = 27
'xlCITurquoise = 28
'xlCIViolet = 29
'xlCIDarkRed = 30
'xlCITeal = 31
'xlCIBlue = 32
xlCISkyBlue = 33
xlCILightGreen = 35
xlCILightYellow = 36
xlCIPaleBlue = 37
xlCIrose = 38
xlCILavender = 39
xlCITan = 40
xlCILightBlue = 41
xlCIAqua = 42
xlCIlime = 43
xlCIGold = 44
xlCILightOrange = 45
xlCIOrange = 46
xlCIBlueGray = 47
xlCIGray40 = 48
xlCIDarkTeal = 49
xlCISeaGreen = 50
xlCIDarkGreen = 51
xlCIBrown = 53
xlCIIndigo = 55
xlCIGray80 = 56
End Enum

Sub Test()
Const nPosties As Long = 8
Dim aryColours
Dim iLastRow As Long
Dim cAddresses As Long
Dim iColour As Long
Dim i As Long

aryColours = Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
xlCILightBlue, _
xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
xlCIPeriwinkle, xlCIPlum)
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
cAddresses = Int((iLastRow - 2) / nPosties)
iColour = 1
For i = 3 To iLastRow
Cells(i, "A").Resize(, 6).Interior.ColorIndex =
aryColours(iColour -
1)
If (i - 2) Mod cAddresses = 0 Then
iColour = iColour + 1
If iColour nPosties Then
iColour = nPosties
End If
End If
Next i

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Major" wrote in message
...
G'day all,

I have lists of addresses that average about 1250 rows & 6 columns, the
list
starts at A3. I need to be able to divide lists into multiples of a number
that's a result from another calculation (the calculation is the number of
addresses they have to deliver to). I'd like to be able to highlight the
first & last row of each multiple or the whole block of the multiple.
Obviously each block would need to be a different colour.


It's a posties delivery round & when we work short we need to divide up
the
vacant round so that the rest of the delivery staff have an equal number
of
addresses to deliver to.
e.g: The list (round) will be divided up by 8 other posties, so, 1227
addresses divided by 8 (other posties) equals 153 addresses each.


If this is possible in Excel it would save the supervisors about an hour a
day working out the addresses to deliver to.


Any help would be REALLY appreciated!!! (we are ALWAYS working short)


--
Cheers

Major Panic