ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   Splitting into Groups (https://www.excelbanter.com/excel-worksheet-functions/147735-splitting-into-groups.html)

tay4432

Splitting into Groups
 
I have a list of Folders and the numbers of pictures they each contain. I
would like to know if it is possible to use Excel to split this list into a
choosen number of groups whose values are as near to equal as possible, so
for example say I have twenty artist with a total of 100 images, I could
split the artists into 4 groups which each have near to 25 images or 5 groups
with 20 images and so on.

If this is possible, I would appreciate any instructions on how to do this.
--
tay4432

Socratis

Splitting into Groups
 
Try this macro:

Public Sub GroupArtists()
Dim totalNumberOfImages As Long ' image count in all folders
Dim desiredNumberOfGroups As Integer
Dim imagesPerGroup As Integer ' what we would like to have
Dim cell As Range
Dim groupNumberOfImages As Integer ' sum of all images in a group
Dim artistNumberOfImages As Integer

totalNumberOfImages = WorksheetFunction.Sum(Range("Images"))
desiredNumberOfGroups = Range("B5").Value
imagesPerGroup = totalNumberOfImages \ desiredNumberOfGroups

' draw a border to separate the groups
' clear any borders to begin with
With Range("Images").Offset(columnoffset:=-1).Resize(columnsize:=2)
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For Each cell In Range("Images")
artistNumberOfImages = cell.Value
groupNumberOfImages = groupNumberOfImages + artistNumberOfImages

If groupNumberOfImages imagesPerGroup Then
If imagesPerGroup - (groupNumberOfImages - artistNumberOfImages)
<= groupNumberOfImages - imagesPerGroup Then
' previous group total is closer to images per group, draw
top border
With
cell.Offset(columnoffset:=-1).Resize(columnsize:=2).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With

' reset the group number of images to be the current
artist's image count,
' since this value is the first value of the next total
groupNumberOfImages = artistNumberOfImages
Else
' current group image total is closer to images per group,
draw bottom border
With
cell.Offset(columnoffset:=-1).Resize(columnsize:=2).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
' reset group number of images to 0, since we are starting a
new total
groupNumberOfImages = 0
End If
End If
Next
End Sub

Basically i am assuming the following:

a) a named range called "Images" that is defined as the column (no header)
containing the image count in each folder.
b) cell B5 in the worksheet contains the desirable number of folders (may
change to fit your needs)
c) folder names are in the left adjacent column to the image counts.

You may change the value in B5 and run the macro to get a new split.

HTH.

Cheers,
socratis

"tay4432" wrote:

I have a list of Folders and the numbers of pictures they each contain. I
would like to know if it is possible to use Excel to split this list into a
choosen number of groups whose values are as near to equal as possible, so
for example say I have twenty artist with a total of 100 images, I could
split the artists into 4 groups which each have near to 25 images or 5 groups
with 20 images and so on.

If this is possible, I would appreciate any instructions on how to do this.
--
tay4432


tay4432

Splitting into Groups
 
Thank you for the help, but I have absolutly no idea how to use this macro,
as I cannot figure out how this is related to an excel sheet. What I've have
are two columns of data, Column A, which is a list of folders, and Column B
which is a list of the number of files in each folder. SO how do I impliment
this macro to do the splitting of this list into groups which all have nearly
the same number of images in each.

Yours
P Taylor

"Socratis" wrote:

Try this macro:

Public Sub GroupArtists()
Dim totalNumberOfImages As Long ' image count in all folders
Dim desiredNumberOfGroups As Integer
Dim imagesPerGroup As Integer ' what we would like to have
Dim cell As Range
Dim groupNumberOfImages As Integer ' sum of all images in a group
Dim artistNumberOfImages As Integer

totalNumberOfImages = WorksheetFunction.Sum(Range("Images"))
desiredNumberOfGroups = Range("B5").Value
imagesPerGroup = totalNumberOfImages \ desiredNumberOfGroups

' draw a border to separate the groups
' clear any borders to begin with
With Range("Images").Offset(columnoffset:=-1).Resize(columnsize:=2)
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For Each cell In Range("Images")
artistNumberOfImages = cell.Value
groupNumberOfImages = groupNumberOfImages + artistNumberOfImages

If groupNumberOfImages imagesPerGroup Then
If imagesPerGroup - (groupNumberOfImages - artistNumberOfImages)
<= groupNumberOfImages - imagesPerGroup Then
' previous group total is closer to images per group, draw
top border
With
cell.Offset(columnoffset:=-1).Resize(columnsize:=2).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With

' reset the group number of images to be the current
artist's image count,
' since this value is the first value of the next total
groupNumberOfImages = artistNumberOfImages
Else
' current group image total is closer to images per group,
draw bottom border
With
cell.Offset(columnoffset:=-1).Resize(columnsize:=2).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
' reset group number of images to 0, since we are starting a
new total
groupNumberOfImages = 0
End If
End If
Next
End Sub

Basically i am assuming the following:

a) a named range called "Images" that is defined as the column (no header)
containing the image count in each folder.
b) cell B5 in the worksheet contains the desirable number of folders (may
change to fit your needs)
c) folder names are in the left adjacent column to the image counts.

You may change the value in B5 and run the macro to get a new split.

HTH.

Cheers,
socratis

"tay4432" wrote:

I have a list of Folders and the numbers of pictures they each contain. I
would like to know if it is possible to use Excel to split this list into a
choosen number of groups whose values are as near to equal as possible, so
for example say I have twenty artist with a total of 100 images, I could
split the artists into 4 groups which each have near to 25 images or 5 groups
with 20 images and so on.

If this is possible, I would appreciate any instructions on how to do this.
--
tay4432


Socratis

Splitting into Groups
 
Here is what you need to do:

a) Column B should be used to define a named range (Images) - include only
the values (number of files).

b) Use cell C1 to add the number of groups you want. Since my code uses B5,
change the following line of code
desiredNumberOfGroups = Range("B5").Value to
desiredNumberOfGroups = Range("C1").Value

c) create the macro: from w/in the worksheet, press alt+F11 to enter the
Visual Basic Editor. Select Tools | Add module. In the module created, paste
the code I provided.

d) Back in the worksheet, run the macro (Tools | Macro), select the name of
the macro procedure (GroupArtists) and click on run.

Good luck with it.

Cheers,
Socratis
"tay4432" wrote:

Thank you for the help, but I have absolutly no idea how to use this macro,
as I cannot figure out how this is related to an excel sheet. What I've have
are two columns of data, Column A, which is a list of folders, and Column B
which is a list of the number of files in each folder. SO how do I impliment
this macro to do the splitting of this list into groups which all have nearly
the same number of images in each.

Yours
P Taylor

"Socratis" wrote:

Try this macro:

Public Sub GroupArtists()
Dim totalNumberOfImages As Long ' image count in all folders
Dim desiredNumberOfGroups As Integer
Dim imagesPerGroup As Integer ' what we would like to have
Dim cell As Range
Dim groupNumberOfImages As Integer ' sum of all images in a group
Dim artistNumberOfImages As Integer

totalNumberOfImages = WorksheetFunction.Sum(Range("Images"))
desiredNumberOfGroups = Range("B5").Value
imagesPerGroup = totalNumberOfImages \ desiredNumberOfGroups

' draw a border to separate the groups
' clear any borders to begin with
With Range("Images").Offset(columnoffset:=-1).Resize(columnsize:=2)
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

For Each cell In Range("Images")
artistNumberOfImages = cell.Value
groupNumberOfImages = groupNumberOfImages + artistNumberOfImages

If groupNumberOfImages imagesPerGroup Then
If imagesPerGroup - (groupNumberOfImages - artistNumberOfImages)
<= groupNumberOfImages - imagesPerGroup Then
' previous group total is closer to images per group, draw
top border
With
cell.Offset(columnoffset:=-1).Resize(columnsize:=2).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With

' reset the group number of images to be the current
artist's image count,
' since this value is the first value of the next total
groupNumberOfImages = artistNumberOfImages
Else
' current group image total is closer to images per group,
draw bottom border
With
cell.Offset(columnoffset:=-1).Resize(columnsize:=2).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
' reset group number of images to 0, since we are starting a
new total
groupNumberOfImages = 0
End If
End If
Next
End Sub

Basically i am assuming the following:

a) a named range called "Images" that is defined as the column (no header)
containing the image count in each folder.
b) cell B5 in the worksheet contains the desirable number of folders (may
change to fit your needs)
c) folder names are in the left adjacent column to the image counts.

You may change the value in B5 and run the macro to get a new split.

HTH.

Cheers,
socratis

"tay4432" wrote:

I have a list of Folders and the numbers of pictures they each contain. I
would like to know if it is possible to use Excel to split this list into a
choosen number of groups whose values are as near to equal as possible, so
for example say I have twenty artist with a total of 100 images, I could
split the artists into 4 groups which each have near to 25 images or 5 groups
with 20 images and so on.

If this is possible, I would appreciate any instructions on how to do this.
--
tay4432


tay4432

Splitting into Groups
 
Thnak yo again for the help. However, I am now having problems running the
macro, which apppear to be due to this part of the coding:

TopBorderWithcell.Offset(columnoffset:=-1).Resize(columnsize:=2).Borders(xlEdgeTop).LineSt yle = xlContinuous.Weight = xlMedium

The problem appears to be with the propeties codes, as when run intially, VB
states that xlcontinuous is an invalid qualifier, and if I try replacing the
xlcontinuous with a enumeration value VB then either says that there is a
syntax error and highlights the entire line or says that there is an compile
error of an "expected: end to the statement" heighlighting the weight
property.
Can you help?

Socratis

Splitting into Groups
 
The code has run together due to wrapping. It should read:
with cell.Offset(columnOffset:=-1).Resize(columnsize:=2).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium

If there are other formatting issues, give me your email and I will email
you the code instead.

Cheers,
Socratis
"tay4432" wrote:

Thnak yo again for the help. However, I am now having problems running the
macro, which apppear to be due to this part of the coding:

TopBorderWithcell.Offset(columnoffset:=-1).Resize(columnsize:=2).Borders(xlEdgeTop).LineSt yle = xlContinuous.Weight = xlMedium

The problem appears to be with the propeties codes, as when run intially, VB
states that xlcontinuous is an invalid qualifier, and if I try replacing the
xlcontinuous with a enumeration value VB then either says that there is a
syntax error and highlights the entire line or says that there is an compile
error of an "expected: end to the statement" heighlighting the weight
property.
Can you help?


tay4432

Splitting into Groups
 
Okay, my email is . Also I am still having
problems, as now when I ru the macro now with the coding in the required
formate:

drawtopborderWithcell.Offset(columnOffset:=-1).Resize(columnsize:=2).Borders(xlEdgeTop)
..LineStyle = xlContinuous
..Weight = xlMedium

It either says syntax error or Compile Error, Expected: =.



All times are GMT +1. The time now is 02:02 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com