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
>