Yup, Thanks Bob!


If I leave the line Dim nPosties As Long after nPosties=Range("J4").Value I get a Duplicate declaration in current scope error
If I take the line out it seems to work OK.... I think
The other problem I have now is if I divide the Round by 20 (can be up to 26 posties) it won't divide up beyond 11 colors.........?? I gets to Red & then stops.
This is what I'm using;
aryColours = Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen, xlCILightBlue, _
xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
xlCIPeriwinkle, xlCIPlum, xlCIRed, xICIGreen, _
xICIYellow, xICIPink, xICITurquoise, xICIIvory, _
xICIOceanBlue, xICIRose, xICILavender, xICITan, _
xICILightBlue, xICIGold, xICITeal, xICILightYellow, _
xICIBrown)

Thanks for youe patience.


--
Cheers

Mark

"Bob Phillips" wrote in message ...
I assumed that would be the case, so I added the constant at the start of
nPosties. You could just change that number, or if you want to make it a bit
more dynamic, I wouldn't use a listbox, I would just use a cell on the
worksheet and type it in. To do that, change

Const nPosties As Long = 8

to

Dim nPosties As Long

and add this line as the first line of code

nPosties = Range("A1").Value 'change to your cell

if You will have more than 10 posties, you will need to add extra colours to
the array, aryColours, as I only setup 10.

--
HTH

Bob Phillips

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

"Major" wrote in message
...
Thanks Bob!

This works a treat!!

Just one question though.

The round isn't always divided up among 8 posties, I just used 8 as an
example.
Can the number that the round is divided by be selected from a drop down
list at say J4?
What do I need to change in the code to be able to do this?


--
Cheers

Major Panic


"Bob Phillips" wrote in message
...
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