Grouping a list in 3's or 4's depending on size?

[Simon Lloyd]

Hi all,

I would like to be able to count the amount of entries in column H and depending on the amount group them in either groups of 3 or 4, all names would be unique...so if there are 14 names in the list they would need to be grouped in to two groups of 4 and two groups of 3, if there were 19 then 4 groups of 4 and 1 group of 3 etc to a maximum 52 people, the results could appearon a seperate worksheet say pasted on to the worksheet starting with the groups of 3 (so paste a group of 3 then skip 3 rows then paste groups of 4 skip 2 rows, the row skipping is to allow seperation and manual entry of extra data). There will never be groups of 5 or more and never less than 3


Hope someone can help....it seems very complex to group all the permutations!


Regards
Simon.

 

[Simon Lloyd]

The list of people has been randomly generated, there will never be groups of 5 or more and never less than 3, 12 players fits nicely in to 3 groups of 4 but 13 players would be 1 group of 4 and 3 groups of 3 and so on...etc the framework in its entirity will accommodate 52 players and at the moment i cut/copy/paste manually from the list to the right of the framework i would like this all to be handled by VBA either through a command button or when the generated list appears column H starting at H4 to H56.

the list could be typically 52 players long or less, if its less than 52 or more than 4 then grouping must take place. Lets take the scenario of 14 players, these would have to be grouped in to 2 groups of 3 and 2 groups of 4, the groups of 3 would need pasting in to the frame work first so the first group would occupy positions 1,2,3 as indicated on the framework the next group would occupy 5,6,7 and so on for all groups of 3 and then repeat for groups of 4, if there were 21 players the grouping would be 3 groups of 3 and 3 groups of 4 and so on for all permutations for up to 52 players.

I may be asking the impossible!!!

Regards,
Simon

 

[wongm003]

Not quite sure what you want to do with the groups... here is a way to get how many groups of 3 and 4.

Public Sub fact34(intVal)

num3 = 0 'number of groups of 3
num4 = 0 'number of groups of 4

'check to see if total is evenly divisible by 4
If intVal Mod 4 = 0 Then
    num4 = intVal / 4
'not evenly divisible by 4
Else
    For x = CInt(intVal / 4) To 0 Step -1
        If (intVal - (4 * x)) Mod 3 = 0 Then
            num3 = (intVal - (4 * x)) / 3
            num4 = x
            x = 0
        End If
    Next x
End If

MsgBox num3 & " - groups of 3" & Chr(10) & num4 & " - groups of 4"

End Sub

 

[Simon Lloyd]

Wong, thanks for the speedy reply, now that you have provided some code to show how many groups of 3's and 4's there are i would like to start copying and pasting using VBA the groups in to a framework, lets say the framework starts at A2, i would like to copy the first 3 names and paste them starting at A2 then skip 3 rows (because the framework allows for 4 names to be pasted a space between groups and a title for each group) paste the next group of 3 if there is one if not paste the group of 4 (if pasting a group of 4 then only skip 2 rows) and carry on pasting until the total number of groups or names has been pasted.

Is this possible?

Regards,
Simon

 

[Simon Lloyd]

Wong i am also bemused as to how to use your code on a certain column!

Could you help a little further please?
Regards,
Simon

 

[wongm003]

Here is one way...

Public Sub copy_values()
'=========================================
' Author: wongm003
' Date: 9/10/06
' Use: highlight values to be copied and run this macro
'=========================================
On Error Resume Next

    Dim cn As Integer
    Dim rn As Integer
    Dim intTot As Integer
    Dim intGrp As Integer
    Dim num3 As Integer
    Dim num4 As Integer

    'initialize variables
    intTot = Selection.Count
    'copy values to...
    cn = Columns("A").Column
    rn = 2                       'start from row
    intGrp = 0
    num3 = 0
    num4 = 0
    
    'determine number of groups of 3 and 4
    'check to see if total is evenly divisible by 4
    If intTot Mod 4 = 0 Then
        num3 = 0
        num4 = intTot / 4
    'not evenly divisible by 4
    Else
        For x = CInt(intTot / 4) To 0 Step -1
            If (intTot - (4 * x)) Mod 3 = 0 Then
                num3 = (intTot - (4 * x)) / 3
                num4 = x
                x = 0
            End If
        Next x
    End If

    'copy each value in selection to appropriate cell
    For Each c In Selection
        Cells(rn, cn).Value = c.Value
        intGrp = intGrp + 1
        rn = rn + 1
        If num3 > 0 And intGrp = 3 Then
            intGrp = 0
            num3 = num3 - 1
            rn = rn + 3
        ElseIf num4 > 0 And intGrp = 4 Then
            intGrp = 0
            num4 = num4 - 1
            rn = rn + 2
        End If
    Next c

End Sub

 

[Simon Lloyd]

Wong........Absolutely brilliant!......Pure Genius!

If only you knew the amount of time i have spent on this........and all the copy paste by hand.

Thanks!
Simon

 

[Simon Lloyd]

Sorry one more small detail...........i need the code to ignore blanks as part of its count.

Regards,
Simon

 

[wongm003]

See changes...

Public Sub copy_values()
'=========================================
' Author: wongm003
' Date: 9/10/06
' Use: highlight values to be copied into
'      new column and grouped then run this
'      macro
'=========================================
On Error Resume Next

    Dim cn As Integer
    Dim rn As Integer
    Dim intTot As Integer
    Dim intGrp As Integer
    Dim num3 As Integer
    Dim num4 As Integer

    'initialize variables
    intTot = 0
    
    'only count non blank items in selection
    For Each c In Selection
        If Len(Trim(c.Value)) > 0 Then intTot = intTot + 1
    Next c

    'copy values to...
    cn = Columns("A").Column
    rn = 2                       'start from row
    intGrp = 0
    num3 = 0
    num4 = 0
    
    'determine number of groups of 3 and 4
    'check to see if total is evenly divisible by 4
    If intTot Mod 4 = 0 Then
        num3 = 0
        num4 = intTot / 4
    'not evenly divisible by 4
    Else
        For x = CInt(intTot / 4) To 0 Step -1
            If (intTot - (4 * x)) Mod 3 = 0 Then
                num3 = (intTot - (4 * x)) / 3
                num4 = x
                x = 0
            End If
        Next x
    End If

    'copy each value in selection to appropriate cell
    For Each c In Selection
        'only copy non blank items in selection
        If Len(Trim(c.Value)) > 0 Then
            Cells(rn, cn).Value = c.Value
            intGrp = intGrp + 1
            rn = rn + 1
            If num3 > 0 And intGrp = 3 Then
                intGrp = 0
                num3 = num3 - 1
                rn = rn + 3
            ElseIf num4 > 0 And intGrp = 4 Then
                intGrp = 0
                num4 = num4 - 1
                rn = rn + 2
            End If
        End If
    Next c

End Sub

 

[Simon Lloyd]

Wong, thanks again!

Simon