Count rows in multiples of 'X' & highlight?

[Major]

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)

 

[Bob Phillips]

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)

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)

 

[Bob Phillips]

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)

 

[Major]

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?

 

[Bob Phillips]

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)

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?

 

[Major]

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.

 

[Bob Phillips]

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)

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.

 

[Major]

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

 

[Bob Phillips]

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)

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

 

[Major]

No problems Bob,

It's on it's way.

 

[Major]

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!


--
Cheers

Major Panic
No problems Bob,

It's on it's way.