Count rows in multiples of 'X' & highlight?

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)


--=20
Cheers

Major Panic

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" <[email protected]> wrote in message
news:[email protected]...
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

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" <[email protected]> wrote in message
news:%[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
> 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
>
>

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.=20
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?


--=20
Cheers

Major Panic


"Bob Phillips" <[email protected]> wrote in message =
news:[email protected]...
> This macros shares them out
>=20
> Sub Test()
> Const nPosties As Long =3D 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
>=20
> aryColours =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
> xlCILightBlue, _
> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
> xlCIPeriwinkle, xlCIPlum)
> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
> cSharedAddresses =3D Int((iLastRow - 2) / nPosties)
> cAddresses =3D cSharedAddresses
> cSpread =3D nPosties - (iLastRow - 2 - cAddresses * nPosties)
> iColour =3D 1
> For i =3D 3 To iLastRow
> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D =
aryColours(iColour -
> 1)
> If (i - 2) Mod cAddresses =3D 0 Then
> iColour =3D iColour + 1
> If iColour > nPosties Then
> iColour =3D nPosties
> End If
> End If
> If cSpread =3D iColour And cAddresses =3D cSharedAddresses Then
> cAddresses =3D cAddresses + 1
> End If
> Next i
>=20
> End Sub
>=20
>=20
>=20
> --=20
> HTH
>=20
> Bob Phillips
>=20
> (replace somewhere in email address with gmail if mailing direct)
>=20
> "Bob Phillips" <[email protected]> wrote in message
> news:%[email protected]...
>> All the extra ones go to the last guy with this code <g>
>>
>> Public Enum xlColorIndex
>> xlCIBlack =3D 1
>> xlCIWhite =3D 2
>> xlCIRed =3D 3
>> xlCIBrightGreen =3D 4
>> xlCIBlue =3D 5
>> xlCIYellow =3D 6
>> xlCIPink =3D 7
>> xlCITurquoise =3D 8
>> xlCIDarkRed =3D 9
>> xlCIGreen =3D 10
>> xlCIDarkBlue =3D 11
>> xlCIDarkYellow =3D 12
>> xlCIViolet =3D 13
>> xlCITeal =3D 14
>> xlCIGray25 =3D 15
>> xlCIGray50 =3D 16
>> xlCIPeriwinkle =3D 17
>> xlCIPlum =3D 18
>> xlCIIvory =3D 19
>> xlCILightTurquoise =3D 20
>> xlCIDarkPurple =3D 21
>> xlCIcoral =3D 22
>> xlCIOceanBlue =3D 23
>> xlCIIceBlue =3D 24
>> 'xlCIDarkBlue =3D 25
>> 'xlCIPink =3D 26
>> 'xlCIYellow =3D 27
>> 'xlCITurquoise =3D 28
>> 'xlCIViolet =3D 29
>> 'xlCIDarkRed =3D 30
>> 'xlCITeal =3D 31
>> 'xlCIBlue =3D 32
>> xlCISkyBlue =3D 33
>> xlCILightGreen =3D 35
>> xlCILightYellow =3D 36
>> xlCIPaleBlue =3D 37
>> xlCIrose =3D 38
>> xlCILavender =3D 39
>> xlCITan =3D 40
>> xlCILightBlue =3D 41
>> xlCIAqua =3D 42
>> xlCIlime =3D 43
>> xlCIGold =3D 44
>> xlCILightOrange =3D 45
>> xlCIOrange =3D 46
>> xlCIBlueGray =3D 47
>> xlCIGray40 =3D 48
>> xlCIDarkTeal =3D 49
>> xlCISeaGreen =3D 50
>> xlCIDarkGreen =3D 51
>> xlCIBrown =3D 53
>> xlCIIndigo =3D 55
>> xlCIGray80 =3D 56
>> End Enum
>>
>> Sub Test()
>> Const nPosties As Long =3D 8
>> Dim aryColours
>> Dim iLastRow As Long
>> Dim cAddresses As Long
>> Dim iColour As Long
>> Dim i As Long
>>
>> aryColours =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>> xlCILightBlue, _
>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>> xlCIPeriwinkle, xlCIPlum)
>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>> cAddresses =3D Int((iLastRow - 2) / nPosties)
>> iColour =3D 1
>> For i =3D 3 To iLastRow
>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
> aryColours(iColour -
>> 1)
>> If (i - 2) Mod cAddresses =3D 0 Then
>> iColour =3D iColour + 1
>> If iColour > nPosties Then
>> iColour =3D nPosties
>> End If
>> End If
>> Next i
>>
>> End Sub
>>
>>
>> --=20
>> HTH
>>
>> Bob Phillips
>>
>> (replace somewhere in email address with gmail if mailing direct)
>>
>> "Major" <[email protected]> wrote in message
>> news:[email protected]...
>> 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)
>>
>>
>> --=20
>> Cheers
>>
>> Major Panic
>>
>>
>=20
>

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" <[email protected]> wrote in message
news:[email protected]...
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" <[email protected]> wrote in message
news:[email protected]...
> 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" <[email protected]> wrote in message
> news:%[email protected]...
>> 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" <[email protected]> wrote in message
>> news:[email protected]...
>> 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
>>
>>
>
>

Yup, Thanks Bob!


If I leave the line Dim nPosties As Long after =
nPosties=3DRange("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 =3D 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.


--=20
Cheers

Mark

"Bob Phillips" <[email protected]> wrote in message =
news:%[email protected]...
>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
>=20
> Const nPosties As Long =3D 8
>=20
> to
>=20
> Dim nPosties As Long
>=20
> and add this line as the first line of code
>=20
> nPosties =3D Range("A1").Value 'change to your cell
>=20
> if You will have more than 10 posties, you will need to add extra =
colours to
> the array, aryColours, as I only setup 10.
>=20
> --=20
> HTH
>=20
> Bob Phillips
>=20
> (replace somewhere in email address with gmail if mailing direct)
>=20
> "Major" <[email protected]> wrote in message
> news:[email protected]...
> Thanks Bob!
>=20
> This works a treat!!
>=20
> Just one question though.
>=20
> 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?
>=20
>=20
> --=20
> Cheers
>=20
> Major Panic
>=20
>=20
> "Bob Phillips" <[email protected]> wrote in message
> news:[email protected]...
>> This macros shares them out
>>
>> Sub Test()
>> Const nPosties As Long =3D 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 =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>> xlCILightBlue, _
>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>> xlCIPeriwinkle, xlCIPlum)
>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>> cSharedAddresses =3D Int((iLastRow - 2) / nPosties)
>> cAddresses =3D cSharedAddresses
>> cSpread =3D nPosties - (iLastRow - 2 - cAddresses * nPosties)
>> iColour =3D 1
>> For i =3D 3 To iLastRow
>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
> aryColours(iColour -
>> 1)
>> If (i - 2) Mod cAddresses =3D 0 Then
>> iColour =3D iColour + 1
>> If iColour > nPosties Then
>> iColour =3D nPosties
>> End If
>> End If
>> If cSpread =3D iColour And cAddresses =3D cSharedAddresses =
Then
>> cAddresses =3D cAddresses + 1
>> End If
>> Next i
>>
>> End Sub
>>
>>
>>
>> --=20
>> HTH
>>
>> Bob Phillips
>>
>> (replace somewhere in email address with gmail if mailing direct)
>>
>> "Bob Phillips" <[email protected]> wrote in message
>> news:%[email protected]...
>>> All the extra ones go to the last guy with this code <g>
>>>
>>> Public Enum xlColorIndex
>>> xlCIBlack =3D 1
>>> xlCIWhite =3D 2
>>> xlCIRed =3D 3
>>> xlCIBrightGreen =3D 4
>>> xlCIBlue =3D 5
>>> xlCIYellow =3D 6
>>> xlCIPink =3D 7
>>> xlCITurquoise =3D 8
>>> xlCIDarkRed =3D 9
>>> xlCIGreen =3D 10
>>> xlCIDarkBlue =3D 11
>>> xlCIDarkYellow =3D 12
>>> xlCIViolet =3D 13
>>> xlCITeal =3D 14
>>> xlCIGray25 =3D 15
>>> xlCIGray50 =3D 16
>>> xlCIPeriwinkle =3D 17
>>> xlCIPlum =3D 18
>>> xlCIIvory =3D 19
>>> xlCILightTurquoise =3D 20
>>> xlCIDarkPurple =3D 21
>>> xlCIcoral =3D 22
>>> xlCIOceanBlue =3D 23
>>> xlCIIceBlue =3D 24
>>> 'xlCIDarkBlue =3D 25
>>> 'xlCIPink =3D 26
>>> 'xlCIYellow =3D 27
>>> 'xlCITurquoise =3D 28
>>> 'xlCIViolet =3D 29
>>> 'xlCIDarkRed =3D 30
>>> 'xlCITeal =3D 31
>>> 'xlCIBlue =3D 32
>>> xlCISkyBlue =3D 33
>>> xlCILightGreen =3D 35
>>> xlCILightYellow =3D 36
>>> xlCIPaleBlue =3D 37
>>> xlCIrose =3D 38
>>> xlCILavender =3D 39
>>> xlCITan =3D 40
>>> xlCILightBlue =3D 41
>>> xlCIAqua =3D 42
>>> xlCIlime =3D 43
>>> xlCIGold =3D 44
>>> xlCILightOrange =3D 45
>>> xlCIOrange =3D 46
>>> xlCIBlueGray =3D 47
>>> xlCIGray40 =3D 48
>>> xlCIDarkTeal =3D 49
>>> xlCISeaGreen =3D 50
>>> xlCIDarkGreen =3D 51
>>> xlCIBrown =3D 53
>>> xlCIIndigo =3D 55
>>> xlCIGray80 =3D 56
>>> End Enum
>>>
>>> Sub Test()
>>> Const nPosties As Long =3D 8
>>> Dim aryColours
>>> Dim iLastRow As Long
>>> Dim cAddresses As Long
>>> Dim iColour As Long
>>> Dim i As Long
>>>
>>> aryColours =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>>> xlCILightBlue, _
>>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>>> xlCIPeriwinkle, xlCIPlum)
>>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>>> cAddresses =3D Int((iLastRow - 2) / nPosties)
>>> iColour =3D 1
>>> For i =3D 3 To iLastRow
>>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
>> aryColours(iColour -
>>> 1)
>>> If (i - 2) Mod cAddresses =3D 0 Then
>>> iColour =3D iColour + 1
>>> If iColour > nPosties Then
>>> iColour =3D nPosties
>>> End If
>>> End If
>>> Next i
>>>
>>> End Sub
>>>
>>>
>>> --=20
>>> HTH
>>>
>>> Bob Phillips
>>>
>>> (replace somewhere in email address with gmail if mailing direct)
>>>
>>> "Major" <[email protected]> wrote in message
>>> news:[email protected]...
>>> 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)
>>>
>>>
>>> --=20
>>> Cheers
>>>
>>> Major Panic
>>>
>>>
>>
>>
>=20
>

Mark,

If you add the Dim nPosties, you need to remove the Const nPosties line.

You typed in the wrong colour names, you preceded with xI (capital I - eye)
not xl (lower l - el). If you used Option Explicit at the start of the code
this would have trapped these errors for you.

The final code would look like this

Sub Test()
Dim nPosties As Long
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, xlCIRed, xlCIGreen, _
xlCIYellow, xlCIPink, xlCITurquoise, xlCIIvory, _
xlCIOceanBlue, xlCIRose, xlCILavender, xlCITan, _
xlCILightBlue, xlCIGold, xlCITeal, xlCILightYellow, _
xlCIBrown)
nPosties = Range("J4").Value
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)

"Major" <[email protected]> wrote in message
news:[email protected]...
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" <[email protected]> wrote in message
news:%[email protected]...
>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" <[email protected]> wrote in message
> news:[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
>> 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" <[email protected]> wrote in message
>> news:%[email protected]...
>>> 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" <[email protected]> wrote in message
>>> news:[email protected]...
>>> 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
>>>
>>>
>>
>>
>
>

Hi Bob,

See what happens when you work with kids, animals & newbies?=20

Thanks! all seems to be fine except... I have no idea why this would =
happen, but, if you divide the round by more than 8 the 9th block is not =
correct.
See here http://www.majorpanic.com/split.gif


--=20
Cheers

Mark

"Bob Phillips" <[email protected]> wrote in message =
news:[email protected]...
> Mark,
>=20
> If you add the Dim nPosties, you need to remove the Const nPosties =
line.
>=20
> You typed in the wrong colour names, you preceded with xI (capital I =
- eye)
> not xl (lower l - el). If you used Option Explicit at the start of the =
code
> this would have trapped these errors for you.
>=20
> The final code would look like this
>=20
> Sub Test()
> Dim nPosties As Long
> 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
>=20
> aryColours =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
> xlCILightBlue, _
> xlCIRose, xlCIlime, xlCIcoral, xlCISkyBlue, _
> xlCIPeriwinkle, xlCIPlum, xlCIRed, xlCIGreen, _
> xlCIYellow, xlCIPink, xlCITurquoise, xlCIIvory, =
_
> xlCIOceanBlue, xlCIRose, xlCILavender, xlCITan, =
_
> xlCILightBlue, xlCIGold, xlCITeal, =
xlCILightYellow, _
> xlCIBrown)
> nPosties =3D Range("J4").Value
> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
> cSharedAddresses =3D Int((iLastRow - 2) / nPosties)
> cAddresses =3D cSharedAddresses
> cSpread =3D nPosties - (iLastRow - 2 - cAddresses * nPosties)
> iColour =3D 1
> For i =3D 3 To iLastRow
> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D =
aryColours(iColour -
> 1)
> If (i - 2) Mod cAddresses =3D 0 Then
> iColour =3D iColour + 1
> If iColour > nPosties Then
> iColour =3D nPosties
> End If
> End If
> If cSpread =3D iColour And cAddresses =3D cSharedAddresses Then
> cAddresses =3D cAddresses + 1
> End If
> Next i
>=20
> End Sub
>=20
>=20
> --=20
> HTH
>=20
> Bob Phillips
>=20
> (replace somewhere in email address with gmail if mailing direct)
>=20
> "Major" <[email protected]> wrote in message
> news:[email protected]...
> Yup, Thanks Bob!
>=20
>=20
> If I leave the line Dim nPosties As Long after =
nPosties=3DRange("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 =3D 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)
>=20
> Thanks for youe patience.
>=20
>=20
> --=20
> Cheers
>=20
> Mark
>=20
> "Bob Phillips" <[email protected]> wrote in message
> news:%[email protected]...
>>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 =3D 8
>>
>> to
>>
>> Dim nPosties As Long
>>
>> and add this line as the first line of code
>>
>> nPosties =3D 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.
>>
>> --=20
>> HTH
>>
>> Bob Phillips
>>
>> (replace somewhere in email address with gmail if mailing direct)
>>
>> "Major" <[email protected]> wrote in message
>> news:[email protected]...
>> 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?
>>
>>
>> --=20
>> Cheers
>>
>> Major Panic
>>
>>
>> "Bob Phillips" <[email protected]> wrote in message
>> news:[email protected]...
>>> This macros shares them out
>>>
>>> Sub Test()
>>> Const nPosties As Long =3D 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 =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>>> xlCILightBlue, _
>>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>>> xlCIPeriwinkle, xlCIPlum)
>>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>>> cSharedAddresses =3D Int((iLastRow - 2) / nPosties)
>>> cAddresses =3D cSharedAddresses
>>> cSpread =3D nPosties - (iLastRow - 2 - cAddresses * nPosties)
>>> iColour =3D 1
>>> For i =3D 3 To iLastRow
>>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
>> aryColours(iColour -
>>> 1)
>>> If (i - 2) Mod cAddresses =3D 0 Then
>>> iColour =3D iColour + 1
>>> If iColour > nPosties Then
>>> iColour =3D nPosties
>>> End If
>>> End If
>>> If cSpread =3D iColour And cAddresses =3D cSharedAddresses =
Then
>>> cAddresses =3D cAddresses + 1
>>> End If
>>> Next i
>>>
>>> End Sub
>>>
>>>
>>>
>>> --=20
>>> HTH
>>>
>>> Bob Phillips
>>>
>>> (replace somewhere in email address with gmail if mailing direct)
>>>
>>> "Bob Phillips" <[email protected]> wrote in message
>>> news:%[email protected]...
>>>> All the extra ones go to the last guy with this code <g>
>>>>
>>>> Public Enum xlColorIndex
>>>> xlCIBlack =3D 1
>>>> xlCIWhite =3D 2
>>>> xlCIRed =3D 3
>>>> xlCIBrightGreen =3D 4
>>>> xlCIBlue =3D 5
>>>> xlCIYellow =3D 6
>>>> xlCIPink =3D 7
>>>> xlCITurquoise =3D 8
>>>> xlCIDarkRed =3D 9
>>>> xlCIGreen =3D 10
>>>> xlCIDarkBlue =3D 11
>>>> xlCIDarkYellow =3D 12
>>>> xlCIViolet =3D 13
>>>> xlCITeal =3D 14
>>>> xlCIGray25 =3D 15
>>>> xlCIGray50 =3D 16
>>>> xlCIPeriwinkle =3D 17
>>>> xlCIPlum =3D 18
>>>> xlCIIvory =3D 19
>>>> xlCILightTurquoise =3D 20
>>>> xlCIDarkPurple =3D 21
>>>> xlCIcoral =3D 22
>>>> xlCIOceanBlue =3D 23
>>>> xlCIIceBlue =3D 24
>>>> 'xlCIDarkBlue =3D 25
>>>> 'xlCIPink =3D 26
>>>> 'xlCIYellow =3D 27
>>>> 'xlCITurquoise =3D 28
>>>> 'xlCIViolet =3D 29
>>>> 'xlCIDarkRed =3D 30
>>>> 'xlCITeal =3D 31
>>>> 'xlCIBlue =3D 32
>>>> xlCISkyBlue =3D 33
>>>> xlCILightGreen =3D 35
>>>> xlCILightYellow =3D 36
>>>> xlCIPaleBlue =3D 37
>>>> xlCIrose =3D 38
>>>> xlCILavender =3D 39
>>>> xlCITan =3D 40
>>>> xlCILightBlue =3D 41
>>>> xlCIAqua =3D 42
>>>> xlCIlime =3D 43
>>>> xlCIGold =3D 44
>>>> xlCILightOrange =3D 45
>>>> xlCIOrange =3D 46
>>>> xlCIBlueGray =3D 47
>>>> xlCIGray40 =3D 48
>>>> xlCIDarkTeal =3D 49
>>>> xlCISeaGreen =3D 50
>>>> xlCIDarkGreen =3D 51
>>>> xlCIBrown =3D 53
>>>> xlCIIndigo =3D 55
>>>> xlCIGray80 =3D 56
>>>> End Enum
>>>>
>>>> Sub Test()
>>>> Const nPosties As Long =3D 8
>>>> Dim aryColours
>>>> Dim iLastRow As Long
>>>> Dim cAddresses As Long
>>>> Dim iColour As Long
>>>> Dim i As Long
>>>>
>>>> aryColours =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>>>> xlCILightBlue, _
>>>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>>>> xlCIPeriwinkle, xlCIPlum)
>>>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>>>> cAddresses =3D Int((iLastRow - 2) / nPosties)
>>>> iColour =3D 1
>>>> For i =3D 3 To iLastRow
>>>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
>>> aryColours(iColour -
>>>> 1)
>>>> If (i - 2) Mod cAddresses =3D 0 Then
>>>> iColour =3D iColour + 1
>>>> If iColour > nPosties Then
>>>> iColour =3D nPosties
>>>> End If
>>>> End If
>>>> Next i
>>>>
>>>> End Sub
>>>>
>>>>
>>>> --=20
>>>> HTH
>>>>
>>>> Bob Phillips
>>>>
>>>> (replace somewhere in email address with gmail if mailing direct)
>>>>
>>>> "Major" <[email protected]> wrote in message
>>>> news:[email protected]...
>>>> 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)
>>>>
>>>>
>>>> --=20
>>>> Cheers
>>>>
>>>> Major Panic
>>>>
>>>>
>>>
>>>
>>
>>
>=20
>

Hi Mark,

That is strange, but I don't reproduce it.

Could you send the file to me to look at?

--
HTH

Bob Phillips

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

"Major" <[email protected]> wrote in message
news:%[email protected]...
Hi Bob,

See what happens when you work with kids, animals & newbies?

Thanks! all seems to be fine except... I have no idea why this would happen,
but, if you divide the round by more than 8 the 9th block is not correct.
See here http://www.majorpanic.com/split.gif


--
Cheers

Mark

"Bob Phillips" <[email protected]> wrote in message
news:[email protected]...
> Mark,
>
> If you add the Dim nPosties, you need to remove the Const nPosties line.
>
> You typed in the wrong colour names, you preceded with xI (capital I -
eye)
> not xl (lower l - el). If you used Option Explicit at the start of the
code
> this would have trapped these errors for you.
>
> The final code would look like this
>
> Sub Test()
> Dim nPosties As Long
> 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, xlCIRed, xlCIGreen, _
> xlCIYellow, xlCIPink, xlCITurquoise, xlCIIvory, _
> xlCIOceanBlue, xlCIRose, xlCILavender, xlCITan, _
> xlCILightBlue, xlCIGold, xlCITeal, xlCILightYellow,
_
> xlCIBrown)
> nPosties = Range("J4").Value
> 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)
>
> "Major" <[email protected]> wrote in message
> news:[email protected]...
> 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" <[email protected]> wrote in message
> news:%[email protected]...
>>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" <[email protected]> wrote in message
>> news:[email protected]...
>> 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" <[email protected]> wrote in message
>> news:[email protected]...
>>> 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" <[email protected]> wrote in message
>>> news:%[email protected]...
>>>> 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" <[email protected]> wrote in message
>>>> news:[email protected]...
>>>> 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
>>>>
>>>>
>>>
>>>
>>
>>
>
>

No problems Bob,

It's on it's way.


--=20
Cheers

Mark


"Bob Phillips" <[email protected]> wrote in message =
news:[email protected]...
> Hi Mark,
>=20
> That is strange, but I don't reproduce it.
>=20
> Could you send the file to me to look at?
>=20
> --=20
> HTH
>=20
> Bob Phillips
>=20
> (replace somewhere in email address with gmail if mailing direct)
>=20
> "Major" <[email protected]> wrote in message
> news:%[email protected]...
> Hi Bob,
>=20
> See what happens when you work with kids, animals & newbies?
>=20
> Thanks! all seems to be fine except... I have no idea why this would =
happen,
> but, if you divide the round by more than 8 the 9th block is not =
correct.
> See here http://www.majorpanic.com/split.gif
>=20
>=20
> --=20
> Cheers
>=20
> Mark
>=20
> "Bob Phillips" <[email protected]> wrote in message
> news:[email protected]...
>> Mark,
>>
>> If you add the Dim nPosties, you need to remove the Const nPosties =
line.
>>
>> You typed in the wrong colour names, you preceded with xI (capital I =
-
> eye)
>> not xl (lower l - el). If you used Option Explicit at the start of =
the
> code
>> this would have trapped these errors for you.
>>
>> The final code would look like this
>>
>> Sub Test()
>> Dim nPosties As Long
>> 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 =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>> xlCILightBlue, _
>> xlCIRose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>> xlCIPeriwinkle, xlCIPlum, xlCIRed, xlCIGreen, _
>> xlCIYellow, xlCIPink, xlCITurquoise, xlCIIvory, =
_
>> xlCIOceanBlue, xlCIRose, xlCILavender, xlCITan, =
_
>> xlCILightBlue, xlCIGold, xlCITeal, =
xlCILightYellow,
> _
>> xlCIBrown)
>> nPosties =3D Range("J4").Value
>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>> cSharedAddresses =3D Int((iLastRow - 2) / nPosties)
>> cAddresses =3D cSharedAddresses
>> cSpread =3D nPosties - (iLastRow - 2 - cAddresses * nPosties)
>> iColour =3D 1
>> For i =3D 3 To iLastRow
>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
> aryColours(iColour -
>> 1)
>> If (i - 2) Mod cAddresses =3D 0 Then
>> iColour =3D iColour + 1
>> If iColour > nPosties Then
>> iColour =3D nPosties
>> End If
>> End If
>> If cSpread =3D iColour And cAddresses =3D cSharedAddresses =
Then
>> cAddresses =3D cAddresses + 1
>> End If
>> Next i
>>
>> End Sub
>>
>>
>> --=20
>> HTH
>>
>> Bob Phillips
>>
>> (replace somewhere in email address with gmail if mailing direct)
>>
>> "Major" <[email protected]> wrote in message
>> news:[email protected]...
>> Yup, Thanks Bob!
>>
>>
>> If I leave the line Dim nPosties As Long after
> nPosties=3DRange("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 =3D 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.
>>
>>
>> --=20
>> Cheers
>>
>> Mark
>>
>> "Bob Phillips" <[email protected]> wrote in message
>> news:%[email protected]...
>>>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 =3D 8
>>>
>>> to
>>>
>>> Dim nPosties As Long
>>>
>>> and add this line as the first line of code
>>>
>>> nPosties =3D 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.
>>>
>>> --=20
>>> HTH
>>>
>>> Bob Phillips
>>>
>>> (replace somewhere in email address with gmail if mailing direct)
>>>
>>> "Major" <[email protected]> wrote in message
>>> news:[email protected]...
>>> 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?
>>>
>>>
>>> --=20
>>> Cheers
>>>
>>> Major Panic
>>>
>>>
>>> "Bob Phillips" <[email protected]> wrote in message
>>> news:[email protected]...
>>>> This macros shares them out
>>>>
>>>> Sub Test()
>>>> Const nPosties As Long =3D 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 =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>>>> xlCILightBlue, _
>>>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>>>> xlCIPeriwinkle, xlCIPlum)
>>>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>>>> cSharedAddresses =3D Int((iLastRow - 2) / nPosties)
>>>> cAddresses =3D cSharedAddresses
>>>> cSpread =3D nPosties - (iLastRow - 2 - cAddresses * nPosties)
>>>> iColour =3D 1
>>>> For i =3D 3 To iLastRow
>>>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
>>> aryColours(iColour -
>>>> 1)
>>>> If (i - 2) Mod cAddresses =3D 0 Then
>>>> iColour =3D iColour + 1
>>>> If iColour > nPosties Then
>>>> iColour =3D nPosties
>>>> End If
>>>> End If
>>>> If cSpread =3D iColour And cAddresses =3D cSharedAddresses =
Then
>>>> cAddresses =3D cAddresses + 1
>>>> End If
>>>> Next i
>>>>
>>>> End Sub
>>>>
>>>>
>>>>
>>>> --=20
>>>> HTH
>>>>
>>>> Bob Phillips
>>>>
>>>> (replace somewhere in email address with gmail if mailing direct)
>>>>
>>>> "Bob Phillips" <[email protected]> wrote in message
>>>> news:%[email protected]...
>>>>> All the extra ones go to the last guy with this code <g>
>>>>>
>>>>> Public Enum xlColorIndex
>>>>> xlCIBlack =3D 1
>>>>> xlCIWhite =3D 2
>>>>> xlCIRed =3D 3
>>>>> xlCIBrightGreen =3D 4
>>>>> xlCIBlue =3D 5
>>>>> xlCIYellow =3D 6
>>>>> xlCIPink =3D 7
>>>>> xlCITurquoise =3D 8
>>>>> xlCIDarkRed =3D 9
>>>>> xlCIGreen =3D 10
>>>>> xlCIDarkBlue =3D 11
>>>>> xlCIDarkYellow =3D 12
>>>>> xlCIViolet =3D 13
>>>>> xlCITeal =3D 14
>>>>> xlCIGray25 =3D 15
>>>>> xlCIGray50 =3D 16
>>>>> xlCIPeriwinkle =3D 17
>>>>> xlCIPlum =3D 18
>>>>> xlCIIvory =3D 19
>>>>> xlCILightTurquoise =3D 20
>>>>> xlCIDarkPurple =3D 21
>>>>> xlCIcoral =3D 22
>>>>> xlCIOceanBlue =3D 23
>>>>> xlCIIceBlue =3D 24
>>>>> 'xlCIDarkBlue =3D 25
>>>>> 'xlCIPink =3D 26
>>>>> 'xlCIYellow =3D 27
>>>>> 'xlCITurquoise =3D 28
>>>>> 'xlCIViolet =3D 29
>>>>> 'xlCIDarkRed =3D 30
>>>>> 'xlCITeal =3D 31
>>>>> 'xlCIBlue =3D 32
>>>>> xlCISkyBlue =3D 33
>>>>> xlCILightGreen =3D 35
>>>>> xlCILightYellow =3D 36
>>>>> xlCIPaleBlue =3D 37
>>>>> xlCIrose =3D 38
>>>>> xlCILavender =3D 39
>>>>> xlCITan =3D 40
>>>>> xlCILightBlue =3D 41
>>>>> xlCIAqua =3D 42
>>>>> xlCIlime =3D 43
>>>>> xlCIGold =3D 44
>>>>> xlCILightOrange =3D 45
>>>>> xlCIOrange =3D 46
>>>>> xlCIBlueGray =3D 47
>>>>> xlCIGray40 =3D 48
>>>>> xlCIDarkTeal =3D 49
>>>>> xlCISeaGreen =3D 50
>>>>> xlCIDarkGreen =3D 51
>>>>> xlCIBrown =3D 53
>>>>> xlCIIndigo =3D 55
>>>>> xlCIGray80 =3D 56
>>>>> End Enum
>>>>>
>>>>> Sub Test()
>>>>> Const nPosties As Long =3D 8
>>>>> Dim aryColours
>>>>> Dim iLastRow As Long
>>>>> Dim cAddresses As Long
>>>>> Dim iColour As Long
>>>>> Dim i As Long
>>>>>
>>>>> aryColours =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>>>>> xlCILightBlue, _
>>>>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, =
_
>>>>> xlCIPeriwinkle, xlCIPlum)
>>>>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>>>>> cAddresses =3D Int((iLastRow - 2) / nPosties)
>>>>> iColour =3D 1
>>>>> For i =3D 3 To iLastRow
>>>>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
>>>> aryColours(iColour -
>>>>> 1)
>>>>> If (i - 2) Mod cAddresses =3D 0 Then
>>>>> iColour =3D iColour + 1
>>>>> If iColour > nPosties Then
>>>>> iColour =3D nPosties
>>>>> End If
>>>>> End If
>>>>> Next i
>>>>>
>>>>> End Sub
>>>>>
>>>>>
>>>>> --=20
>>>>> HTH
>>>>>
>>>>> Bob Phillips
>>>>>
>>>>> (replace somewhere in email address with gmail if mailing direct)
>>>>>
>>>>> "Major" <[email protected]> wrote in message
>>>>> news:[email protected]...
>>>>> 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)
>>>>>
>>>>>
>>>>> --=20
>>>>> Cheers
>>>>>
>>>>> Major Panic
>>>>>
>>>>>
>>>>
>>>>
>>>
>>>
>>
>>
>=20
>

Thanks Bob!

It works likes an absolute champion!
I really appreciate all the work you have put in on this on my behalf.

Thank You!


--=20
Cheers

Major Panic
"Major" <[email protected]> wrote in message =
news:[email protected]...
No problems Bob,

It's on it's way.


--=20
Cheers

Mark


"Bob Phillips" <[email protected]> wrote in message =
news:[email protected]...
> Hi Mark,
>=20
> That is strange, but I don't reproduce it.
>=20
> Could you send the file to me to look at?
>=20
> --=20
> HTH
>=20
> Bob Phillips
>=20
> (replace somewhere in email address with gmail if mailing direct)
>=20
> "Major" <[email protected]> wrote in message
> news:%[email protected]...
> Hi Bob,
>=20
> See what happens when you work with kids, animals & newbies?
>=20
> Thanks! all seems to be fine except... I have no idea why this would =
happen,
> but, if you divide the round by more than 8 the 9th block is not =
correct.
> See here http://www.majorpanic.com/split.gif
>=20
>=20
> --=20
> Cheers
>=20
> Mark
>=20
> "Bob Phillips" <[email protected]> wrote in message
> news:[email protected]...
>> Mark,
>>
>> If you add the Dim nPosties, you need to remove the Const nPosties =
line.
>>
>> You typed in the wrong colour names, you preceded with xI (capital I =
-
> eye)
>> not xl (lower l - el). If you used Option Explicit at the start of =
the
> code
>> this would have trapped these errors for you.
>>
>> The final code would look like this
>>
>> Sub Test()
>> Dim nPosties As Long
>> 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 =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>> xlCILightBlue, _
>> xlCIRose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>> xlCIPeriwinkle, xlCIPlum, xlCIRed, xlCIGreen, _
>> xlCIYellow, xlCIPink, xlCITurquoise, xlCIIvory, =
_
>> xlCIOceanBlue, xlCIRose, xlCILavender, xlCITan, =
_
>> xlCILightBlue, xlCIGold, xlCITeal, =
xlCILightYellow,
> _
>> xlCIBrown)
>> nPosties =3D Range("J4").Value
>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>> cSharedAddresses =3D Int((iLastRow - 2) / nPosties)
>> cAddresses =3D cSharedAddresses
>> cSpread =3D nPosties - (iLastRow - 2 - cAddresses * nPosties)
>> iColour =3D 1
>> For i =3D 3 To iLastRow
>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
> aryColours(iColour -
>> 1)
>> If (i - 2) Mod cAddresses =3D 0 Then
>> iColour =3D iColour + 1
>> If iColour > nPosties Then
>> iColour =3D nPosties
>> End If
>> End If
>> If cSpread =3D iColour And cAddresses =3D cSharedAddresses =
Then
>> cAddresses =3D cAddresses + 1
>> End If
>> Next i
>>
>> End Sub
>>
>>
>> --=20
>> HTH
>>
>> Bob Phillips
>>
>> (replace somewhere in email address with gmail if mailing direct)
>>
>> "Major" <[email protected]> wrote in message
>> news:[email protected]...
>> Yup, Thanks Bob!
>>
>>
>> If I leave the line Dim nPosties As Long after
> nPosties=3DRange("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 =3D 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.
>>
>>
>> --=20
>> Cheers
>>
>> Mark
>>
>> "Bob Phillips" <[email protected]> wrote in message
>> news:%[email protected]...
>>>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 =3D 8
>>>
>>> to
>>>
>>> Dim nPosties As Long
>>>
>>> and add this line as the first line of code
>>>
>>> nPosties =3D 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.
>>>
>>> --=20
>>> HTH
>>>
>>> Bob Phillips
>>>
>>> (replace somewhere in email address with gmail if mailing direct)
>>>
>>> "Major" <[email protected]> wrote in message
>>> news:[email protected]...
>>> 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?
>>>
>>>
>>> --=20
>>> Cheers
>>>
>>> Major Panic
>>>
>>>
>>> "Bob Phillips" <[email protected]> wrote in message
>>> news:[email protected]...
>>>> This macros shares them out
>>>>
>>>> Sub Test()
>>>> Const nPosties As Long =3D 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 =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>>>> xlCILightBlue, _
>>>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, _
>>>> xlCIPeriwinkle, xlCIPlum)
>>>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>>>> cSharedAddresses =3D Int((iLastRow - 2) / nPosties)
>>>> cAddresses =3D cSharedAddresses
>>>> cSpread =3D nPosties - (iLastRow - 2 - cAddresses * nPosties)
>>>> iColour =3D 1
>>>> For i =3D 3 To iLastRow
>>>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
>>> aryColours(iColour -
>>>> 1)
>>>> If (i - 2) Mod cAddresses =3D 0 Then
>>>> iColour =3D iColour + 1
>>>> If iColour > nPosties Then
>>>> iColour =3D nPosties
>>>> End If
>>>> End If
>>>> If cSpread =3D iColour And cAddresses =3D cSharedAddresses =
Then
>>>> cAddresses =3D cAddresses + 1
>>>> End If
>>>> Next i
>>>>
>>>> End Sub
>>>>
>>>>
>>>>
>>>> --=20
>>>> HTH
>>>>
>>>> Bob Phillips
>>>>
>>>> (replace somewhere in email address with gmail if mailing direct)
>>>>
>>>> "Bob Phillips" <[email protected]> wrote in message
>>>> news:%[email protected]...
>>>>> All the extra ones go to the last guy with this code <g>
>>>>>
>>>>> Public Enum xlColorIndex
>>>>> xlCIBlack =3D 1
>>>>> xlCIWhite =3D 2
>>>>> xlCIRed =3D 3
>>>>> xlCIBrightGreen =3D 4
>>>>> xlCIBlue =3D 5
>>>>> xlCIYellow =3D 6
>>>>> xlCIPink =3D 7
>>>>> xlCITurquoise =3D 8
>>>>> xlCIDarkRed =3D 9
>>>>> xlCIGreen =3D 10
>>>>> xlCIDarkBlue =3D 11
>>>>> xlCIDarkYellow =3D 12
>>>>> xlCIViolet =3D 13
>>>>> xlCITeal =3D 14
>>>>> xlCIGray25 =3D 15
>>>>> xlCIGray50 =3D 16
>>>>> xlCIPeriwinkle =3D 17
>>>>> xlCIPlum =3D 18
>>>>> xlCIIvory =3D 19
>>>>> xlCILightTurquoise =3D 20
>>>>> xlCIDarkPurple =3D 21
>>>>> xlCIcoral =3D 22
>>>>> xlCIOceanBlue =3D 23
>>>>> xlCIIceBlue =3D 24
>>>>> 'xlCIDarkBlue =3D 25
>>>>> 'xlCIPink =3D 26
>>>>> 'xlCIYellow =3D 27
>>>>> 'xlCITurquoise =3D 28
>>>>> 'xlCIViolet =3D 29
>>>>> 'xlCIDarkRed =3D 30
>>>>> 'xlCITeal =3D 31
>>>>> 'xlCIBlue =3D 32
>>>>> xlCISkyBlue =3D 33
>>>>> xlCILightGreen =3D 35
>>>>> xlCILightYellow =3D 36
>>>>> xlCIPaleBlue =3D 37
>>>>> xlCIrose =3D 38
>>>>> xlCILavender =3D 39
>>>>> xlCITan =3D 40
>>>>> xlCILightBlue =3D 41
>>>>> xlCIAqua =3D 42
>>>>> xlCIlime =3D 43
>>>>> xlCIGold =3D 44
>>>>> xlCILightOrange =3D 45
>>>>> xlCIOrange =3D 46
>>>>> xlCIBlueGray =3D 47
>>>>> xlCIGray40 =3D 48
>>>>> xlCIDarkTeal =3D 49
>>>>> xlCISeaGreen =3D 50
>>>>> xlCIDarkGreen =3D 51
>>>>> xlCIBrown =3D 53
>>>>> xlCIIndigo =3D 55
>>>>> xlCIGray80 =3D 56
>>>>> End Enum
>>>>>
>>>>> Sub Test()
>>>>> Const nPosties As Long =3D 8
>>>>> Dim aryColours
>>>>> Dim iLastRow As Long
>>>>> Dim cAddresses As Long
>>>>> Dim iColour As Long
>>>>> Dim i As Long
>>>>>
>>>>> aryColours =3D Array(xlCIPaleBlue, xlCIGray25, xlCILightGreen,
>>>>> xlCILightBlue, _
>>>>> xlCIrose, xlCIlime, xlCIcoral, xlCISkyBlue, =
_
>>>>> xlCIPeriwinkle, xlCIPlum)
>>>>> iLastRow =3D Cells(Rows.Count, "A").End(xlUp).Row
>>>>> cAddresses =3D Int((iLastRow - 2) / nPosties)
>>>>> iColour =3D 1
>>>>> For i =3D 3 To iLastRow
>>>>> Cells(i, "A").Resize(, 6).Interior.ColorIndex =3D
>>>> aryColours(iColour -
>>>>> 1)
>>>>> If (i - 2) Mod cAddresses =3D 0 Then
>>>>> iColour =3D iColour + 1
>>>>> If iColour > nPosties Then
>>>>> iColour =3D nPosties
>>>>> End If
>>>>> End If
>>>>> Next i
>>>>>
>>>>> End Sub
>>>>>
>>>>>
>>>>> --=20
>>>>> HTH
>>>>>
>>>>> Bob Phillips
>>>>>
>>>>> (replace somewhere in email address with gmail if mailing direct)
>>>>>
>>>>> "Major" <[email protected]> wrote in message
>>>>> news:[email protected]...
>>>>> 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)
>>>>>
>>>>>
>>>>> --=20
>>>>> Cheers
>>>>>
>>>>> Major Panic
>>>>>
>>>>>
>>>>
>>>>
>>>
>>>
>>
>>
>=20
>