Make possible set of 5 numbers using 4 groups.

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
Office Version
  1. 2010
Hello,

I have got 4 groups of 5 numbers as follow...
Group1-In the column "B" with 5 numbers
Group2-In the column "C" with 5 numbers
Group3-In the column "D" with 5 numbers
Group4-In the column "E" with 5 numbers

In fact using 20 numbers and making sets of numbers there must be total combinations =COMBIN(20,5) = 15.504

But I want to limit that the to make the set of 5 numbers it must pick 1 number from any of 3 groups and the 2 numbers from any of 1 group... I am not sure how much total combinations will be produce using this way

Please see the attached image example for more information

Please suggest VBA

*ABCDEFGHIJKLM
1
2
3
4Group 1Group 2Group 3Group 4n1n2n3n4n5
5117274413172744
63183245117182744
75223647112223247
882442481224364248
912254350122364748
10825273648
11522324247
12
13
14
15
16

Thank you all.

I am using Excel 2000

Regards,
Moti
 

Attachments

  • Set of 5 num from 4 groups.png
    Set of 5 num from 4 groups.png
    13.2 KB · Views: 37
Sort by date Sort by votes
Five_numbers.xlsm
ABCD
1Group 1Group 2Group 3Group 4
2G11G21G31G41
3G12G22G32G42
4G13G23G33G43
5G14G24G34G44
6G15G25G35G45
Sheet1


Your sample data is range A2:D6, run the following code:
VBA Code: 
Public Sub Five_numbers()
Dim arrData, arrDec
Dim isUni As Boolean
Dim i1&, i2&, i3&, i4&, j&, c&, u&, k&
ReDim arrDec(1 To 10000, 1 To 5)
arrData = Range("A2:D6").Value ' Change here

u = UBound(arrData, 1)
For i1 = 1 To u
    For i2 = 1 To u
        For i3 = 1 To u
            For i4 = 1 To u
                For c = 1 To 4
                    For j = 1 To u
                        isUni = False
                        Select Case c
                        Case 1
                            If j = i1 Then isUni = True
                        Case 2
                            If j = i2 Then isUni = True
                        Case 3
                            If j = i3 Then isUni = True
                        Case 4
                            If j = i4 Then isUni = True
                        End Select
                            If isUni = False Then
                                k = k + 1
                                arrDec(k, 1) = arrData(i1, 1)
                                arrDec(k, 2) = arrData(i2, 2)
                                arrDec(k, 3) = arrData(i3, 3)
                                arrDec(k, 4) = arrData(i4, 4)
                                arrDec(k, 5) = arrData(j, c)
                            End If
                    Next j
                Next c
            Next i4
        Next i3
    Next i2
Next i1
Range("G1").Resize(k, 5).Value = arrDec
End Sub
 
Upvote 0

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Phuoc said:
Sorry!

After checking it, the combination number is not 10000.
Click to expand...
Phuoc, Should it be 5000 correct I was trying to figure it out but could not understand the logic of the formulas between your's and @footoo's

No problem at all I do appreciate your help and time you spend and trying to solve it at least

Good luck and have a great weekend

Kind Regards,
Moti
 
Last edited:
Upvote 0
VBA Code: 
Public Sub Five_numbers()
Dim dic As Object
Dim arrData, arrDec
Dim isUni As Boolean
Dim arr
Dim ID As String
Dim i1&, i2&, i3&, i4&, j&, c&, u&, k&
Set dic = CreateObject("Scripting.Dictionary")
ReDim arrDec(1 To 10000, 1 To 5)
ReDim arr(1 To 5)
arrData = Range("A2:D6").Value ' Change here

u = UBound(arrData, 1)
For i1 = 1 To u
    arr(1) = arrData(i1, 1)
    For i2 = 1 To u
        arr(2) = arrData(i2, 2)
        For i3 = 1 To u
            arr(3) = arrData(i3, 3)
            For i4 = 1 To u
                arr(4) = arrData(i4, 4)
                For c = 1 To 4
                    For j = 1 To u
                        isUni = False
                        Select Case c
                        Case 1
                            If j = i1 Then isUni = True
                        Case 2
                            If j = i2 Then isUni = True
                        Case 3
                            If j = i3 Then isUni = True
                        Case 4
                            If j = i4 Then isUni = True
                        End Select
                            If isUni = False Then
                            arr(5) = arrData(j, c)
                            ID = Mysort(arr)
                            If dic.exists(ID) = False Then
                                k = k + 1
                                dic.Item(ID) = k
                                arrDec(k, 1) = arrData(i1, 1)
                                arrDec(k, 2) = arrData(i2, 2)
                                arrDec(k, 3) = arrData(i3, 3)
                                arrDec(k, 4) = arrData(i4, 4)
                                arrDec(k, 5) = arrData(j, c)
                            End If
                            End If
                    Next j
                Next c
            Next i4
        Next i3
    Next i2
Next i1
Range("G1").Resize(k, 5).Value = arrDec
MsgBox k
End Sub

''''
Function Mysort(ByVal a As Variant) As String
Dim i As Long, ii As Long, s As Variant
For i = 1 To 4
    For ii = i + 1 To 5
        If a(i) > a(ii) Then
            s = a(i)
            a(i) = a(ii)
            a(ii) = s
        End If
    Next ii
Next i
Mysort = a(1) & "|" & a(2) & "|" & a(3) & "|" & a(4) & "|" & a(5)
End Function

This code has a result of 5000 combinations.
 
Upvote 0
Phuoc said:
VBA Code: 
Public Sub Five_numbers()
Dim dic As Object
Dim arrData, arrDec
Dim isUni As Boolean
Dim arr
Dim ID As String
Dim i1&, i2&, i3&, i4&, j&, c&, u&, k&
Set dic = CreateObject("Scripting.Dictionary")
ReDim arrDec(1 To 10000, 1 To 5)
ReDim arr(1 To 5)
arrData = Range("A2:D6").Value ' Change here

u = UBound(arrData, 1)
For i1 = 1 To u
    arr(1) = arrData(i1, 1)
    For i2 = 1 To u
        arr(2) = arrData(i2, 2)
        For i3 = 1 To u
            arr(3) = arrData(i3, 3)
            For i4 = 1 To u
                arr(4) = arrData(i4, 4)
                For c = 1 To 4
                    For j = 1 To u
                        isUni = False
                        Select Case c
                        Case 1
                            If j = i1 Then isUni = True
                        Case 2
                            If j = i2 Then isUni = True
                        Case 3
                            If j = i3 Then isUni = True
                        Case 4
                            If j = i4 Then isUni = True
                        End Select
                            If isUni = False Then
                            arr(5) = arrData(j, c)
                            ID = Mysort(arr)
                            If dic.exists(ID) = False Then
                                k = k + 1
                                dic.Item(ID) = k
                                arrDec(k, 1) = arrData(i1, 1)
                                arrDec(k, 2) = arrData(i2, 2)
                                arrDec(k, 3) = arrData(i3, 3)
                                arrDec(k, 4) = arrData(i4, 4)
                                arrDec(k, 5) = arrData(j, c)
                            End If
                            End If
                    Next j
                Next c
            Next i4
        Next i3
    Next i2
Next i1
Range("G1").Resize(k, 5).Value = arrDec
MsgBox k
End Sub

''''
Function Mysort(ByVal a As Variant) As String
Dim i As Long, ii As Long, s As Variant
For i = 1 To 4
    For ii = i + 1 To 5
        If a(i) > a(ii) Then
            s = a(i)
            a(i) = a(ii)
            a(ii) = s
        End If
    Next ii
Next i
Mysort = a(1) & "|" & a(2) & "|" & a(3) & "|" & a(4) & "|" & a(5)
End Function

This code has a result of 5000 combinations.
Click to expand...
Phuoc, I am sure this must be the correct macro with 5000 combinations. This is what I needed and was after it. I really appreciate your kind help.

One thing does it is possible to sort data smallest to largest number. For example first combination is generated... 1,17,27,44,3 could it be in order as follow ... 1,3,17,27 and 44

Kind Regards,
Moti :)
 
Upvote 0
motilulla said:
For example first combination is generated... 1,17,27,44,3 could it be in order as follow ... 1,3,17,27 and 44
Click to expand...
Try this code:
VBA Code: 
Public Sub Five_numbers()
Dim dic As Object
Dim arrData, arrDec
Dim isUni As Boolean
Dim arr, arrB
Dim ID As String
Dim i1&, i2&, i3&, i4&, j&, c&, u&, k&
Set dic = CreateObject("Scripting.Dictionary")
ReDim arrDec(1 To 10000, 1 To 5)
ReDim arr(1 To 5)
arrData = Range("A2:D6").Value ' Change here

u = UBound(arrData, 1)
For i1 = 1 To u
    arr(1) = arrData(i1, 1)
    For i2 = 1 To u
        arr(2) = arrData(i2, 2)
        For i3 = 1 To u
            arr(3) = arrData(i3, 3)
            For i4 = 1 To u
                arr(4) = arrData(i4, 4)
                For c = 1 To 4
                    For j = 1 To u
                        isUni = False
                        Select Case c
                        Case 1
                            If j = i1 Then isUni = True
                        Case 2
                            If j = i2 Then isUni = True
                        Case 3
                            If j = i3 Then isUni = True
                        Case 4
                            If j = i4 Then isUni = True
                        End Select
                            If isUni = False Then
                            arr(5) = arrData(j, c)
                            arrB = Mysort(arr)
                           ID = arrB(1) & "|" & arrB(2) & "|" & arrB(3) & "|" & arrB(4) & "|" & arrB(5)
                            If dic.exists(ID) = False Then
                                k = k + 1
                                dic.Item(ID) = k
                                arrDec(k, 1) = arrB(1)
                                arrDec(k, 2) = arrB(2)
                                arrDec(k, 3) = arrB(3)
                                arrDec(k, 4) = arrB(4)
                                arrDec(k, 5) = arrB(5)
                            End If
                            End If
                    Next j
                Next c
            Next i4
        Next i3
    Next i2
Next i1
Range("G1").Resize(k, 5).Value = arrDec
MsgBox k
End Sub
Function Mysort(ByVal a As Variant) As Variant
Dim i As Long, ii As Long, s As Variant
For i = 1 To 4
    For ii = i + 1 To 5
        If a(i) > a(ii) Then
            s = a(i)
            a(i) = a(ii)
            a(ii) = s
        End If
    Next ii
Next i
Mysort = a
End Function
 
Upvote 1
Solution
Phuoc said:
Try this code:
VBA Code: 
Public Sub Five_numbers()
Dim dic As Object
Dim arrData, arrDec
Dim isUni As Boolean
Dim arr, arrB
Dim ID As String
Dim i1&, i2&, i3&, i4&, j&, c&, u&, k&
Set dic = CreateObject("Scripting.Dictionary")
ReDim arrDec(1 To 10000, 1 To 5)
ReDim arr(1 To 5)
arrData = Range("A2:D6").Value ' Change here

u = UBound(arrData, 1)
For i1 = 1 To u
    arr(1) = arrData(i1, 1)
    For i2 = 1 To u
        arr(2) = arrData(i2, 2)
        For i3 = 1 To u
            arr(3) = arrData(i3, 3)
            For i4 = 1 To u
                arr(4) = arrData(i4, 4)
                For c = 1 To 4
                    For j = 1 To u
                        isUni = False
                        Select Case c
                        Case 1
                            If j = i1 Then isUni = True
                        Case 2
                            If j = i2 Then isUni = True
                        Case 3
                            If j = i3 Then isUni = True
                        Case 4
                            If j = i4 Then isUni = True
                        End Select
                            If isUni = False Then
                            arr(5) = arrData(j, c)
                            arrB = Mysort(arr)
                           ID = arrB(1) & "|" & arrB(2) & "|" & arrB(3) & "|" & arrB(4) & "|" & arrB(5)
                            If dic.exists(ID) = False Then
                                k = k + 1
                                dic.Item(ID) = k
                                arrDec(k, 1) = arrB(1)
                                arrDec(k, 2) = arrB(2)
                                arrDec(k, 3) = arrB(3)
                                arrDec(k, 4) = arrB(4)
                                arrDec(k, 5) = arrB(5)
                            End If
                            End If
                    Next j
                Next c
            Next i4
        Next i3
    Next i2
Next i1
Range("G1").Resize(k, 5).Value = arrDec
MsgBox k
End Sub
Function Mysort(ByVal a As Variant) As Variant
Dim i As Long, ii As Long, s As Variant
For i = 1 To 4
    For ii = i + 1 To 5
        If a(i) > a(ii) Then
            s = a(i)
            a(i) = a(ii)
            a(ii) = s
        End If
    Next ii
Next i
Mysort = a
End Function
Click to expand...
Phuoc, So kind of you for altering a code quickly it worked amazing as treat. (y)

I healthy appreciate your kind help

Wishing you Good Luck and have a nice weekend.

Kind Regards,
Moti :)
 
Upvote 0
Phuoc said:
Try this code:
VBA Code: 
Public Sub Five_numbers()
Dim dic As Object
Dim arrData, arrDec
Dim isUni As Boolean
Dim arr, arrB
Dim ID As String
Dim i1&, i2&, i3&, i4&, j&, c&, u&, k&
Set dic = CreateObject("Scripting.Dictionary")
ReDim arrDec(1 To 10000, 1 To 5)
ReDim arr(1 To 5)
arrData = Range("A2:D6").Value ' Change here

u = UBound(arrData, 1)
For i1 = 1 To u
    arr(1) = arrData(i1, 1)
    For i2 = 1 To u
        arr(2) = arrData(i2, 2)
        For i3 = 1 To u
            arr(3) = arrData(i3, 3)
            For i4 = 1 To u
                arr(4) = arrData(i4, 4)
                For c = 1 To 4
                    For j = 1 To u
                        isUni = False
                        Select Case c
                        Case 1
                            If j = i1 Then isUni = True
                        Case 2
                            If j = i2 Then isUni = True
                        Case 3
                            If j = i3 Then isUni = True
                        Case 4
                            If j = i4 Then isUni = True
                        End Select
                            If isUni = False Then
                            arr(5) = arrData(j, c)
                            arrB = Mysort(arr)
                           ID = arrB(1) & "|" & arrB(2) & "|" & arrB(3) & "|" & arrB(4) & "|" & arrB(5)
                            If dic.exists(ID) = False Then
                                k = k + 1
                                dic.Item(ID) = k
                                arrDec(k, 1) = arrB(1)
                                arrDec(k, 2) = arrB(2)
                                arrDec(k, 3) = arrB(3)
                                arrDec(k, 4) = arrB(4)
                                arrDec(k, 5) = arrB(5)
                            End If
                            End If
                    Next j
                Next c
            Next i4
        Next i3
    Next i2
Next i1
Range("G1").Resize(k, 5).Value = arrDec
MsgBox k
End Sub
Function Mysort(ByVal a As Variant) As Variant
Dim i As Long, ii As Long, s As Variant
For i = 1 To 4
    For ii = i + 1 To 5
        If a(i) > a(ii) Then
            s = a(i)
            a(i) = a(ii)
            a(ii) = s
        End If
    Next ii
Next i
Mysort = a
End Function
Click to expand...
Hello Phuoc ,

You made this VBA for me years ago which is working fantastic. With the time I realize I need to add 2 more columns so I have request modification of it under the following link. Please I want your help is it possible to adapt as per new request.

www.mrexcel.com

Pick 5 numbers from the 6 groups

Using Excel 2010 Hello, The macro below creates combinations of 5 numbers out of 1st 4 groups. (Group1, Group 2, Group 3 and Group 4…are shown in yellow) But now I require modifications so it can create all possible combinations of 5 numbers using 6 groups.... From Group1 to Group6 (including...
www.mrexcel.com www.mrexcel.com

Thank you.

Regards,
Moti
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Solved
Dynamic arrays, circular arguments and all I want to due is increment a previous number
Replies
3
Views
114
djclements
djclements
L
  • Question Question
radio buttons determining cell values with 2 sets of equations, the first half of the formula works, but second half doesn't
Replies
1
Views
71
Kaper
Kaper
M
  • Question Question
#Value Error - Please Help
Replies
3
Views
66
Alex Blakenburg
A
V
  • Solved
Creating a new filtered list from a dynamically created list based on previous numbers
Replies
6
Views
136
DanteAmor
DanteAmor
B
  • Solved
timestamp listing to show more than >19hrs away per day?
Replies
6
Views
114
Kaper
Kaper

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top