How can I make this vba work the way I need? - excel

Question

I modified this vba code to generate combinations of six from 10 groups of pairs where only one number of a pair is used for each combination. but I can't get exactly what i want, and there many repetitions of the same combinations and some numbers are not even used in combinations. Can I get a little help to fix this code, please? thanks.
Here is the vba:
Sub Combs()
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim f As Long
Dim g As Long
Dim h As Long
Dim j As Long
Dim k As Long
Dim i As Long
Dim grp
grp = Range("B1:C10").Value
Dim arr(1 To 1025, 1 To 10) As Long
For a = 1 To 2
For b = 1 To 2
For c = 1 To 2
For d = 1 To 2
For e = 1 To 2
For f = 1 To 2
For g = 1 To 2
For h = 1 To 2
For j = 1 To 2
For k = 1 To 2
i = i + 1
arr(i, 1) = grp(1, a)
arr(i, 2) = grp(2, b)
arr(i, 3) = grp(3, c)
arr(i, 4) = grp(4, d)
arr(i, 5) = grp(5, e)
arr(i, 6) = grp(6, f)
arr(i, 7) = grp(7, g)
arr(i, 8) = grp(8, h)
arr(i, 9) = grp(9, j)
arr(i, 10) = grp(10, k)
Next k
Next j
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a
Application.ScreenUpdating = False
Range("H2").Resize(1025, 6).Value = arr
Application.ScreenUpdating = True
End Sub
Here is a sample data:
Group1 1 2
Group2 3 4
Group3 5 6
Group4 7 8
Group5 9 10
Group6 11 12
Group7 13 14
Group8 15 16
Group9 17 18
Group10 19 20

Answer 1

I'm guessing your want to randomly select 6 from 10
Sub Combos()
Dim i As Integer, j As Integer, k As Integer, n As Integer
Dim c As Integer, digit As Integer
Dim b As String, bb As String
Dim grp, arr(1 To 1025, 1 To 10) As Long, cols
' group data
grp = Range("B1:C10").Value
For j = 0 To 31
b = CStr(WorksheetFunction.Dec2Bin(j, 5))
For k = 0 To 31
bb = b & CStr(WorksheetFunction.Dec2Bin(k, 5))
i = j * 32 + k + 1
' select 6 of the 10 columns
cols = SixFromTen
Range("V" & i + 1) = Join(cols, ",") ' show combo
For c = 0 To 5
n = cols(c) '
'Debug.Print j, k, n
digit = CInt(Mid(bb, n, 1)) ' binary digit
arr(i, c + 1) = grp(n, digit + 1)
Next
Next
Next
Range("O2").Resize(1025, 6).Value = arr
MsgBox "Done"
End Sub
Function SixFromTen() As Variant
Dim num As New Collection, ar(5) As String
Dim i As Integer, n As Integer
Dim a As Integer, b As Integer, tmp As Integer
For n = 1 To 10
num.Add n
Next
For i = 0 To 5
n = 1 + Int(Rnd() * num.Count)
ar(i) = num(n)
num.Remove n
Next
'bubble sort
For a = 0 To 4
For b = a + 1 To 5
If CInt(ar(a)) > CInt(ar(b)) Then
tmp = ar(a)
ar(a) = ar(b)
ar(b) = tmp
End If
Next
Next
SixFromTen = ar
End Function
Alternatively remove 4 from 10 to leave 6 in correct order.
Function SixFromTen() As Variant
Dim num As New Collection, ar(5) As String
Dim i As Integer, n As Integer
For n = 1 To 10: num.Add n: Next
' remove 4
For i = 0 To 3
n = 1 + Int(Rnd() * num.Count)
num.Remove n
Next
For i = 0 To 5: ar(i) = num(i + 1): Next
SixFromTen = ar
End Function

Answer 2

As AcsErno pointed out, the issue is that your program is generating ten columns of digits but the output is only for six columns. Removing four columns results in many repeated combinations because the unique part has been removed in those four columns.
The solution is to only generate six columns, therefore allowing each of them to remain unique. I have rewritten your program to only generate six columns:
Sub Combs()
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long
Dim i As Long, arr(1 To 1025, 1 To 6) As Long
Dim grp() As Variant
grp = Range("B1:C6").Value
For a = 1 To 2
For b = 1 To 2
For c = 1 To 2
For d = 1 To 2
For e = 1 To 2
For f = 1 To 2
i = i + 1
arr(i, 1) = grp(1, a)
arr(i, 2) = grp(2, b)
arr(i, 3) = grp(3, c)
arr(i, 4) = grp(4, d)
arr(i, 5) = grp(5, e)
arr(i, 6) = grp(6, f)
Next f
Next e
Next d
Next c
Next b
Next a
Application.ScreenUpdating = False
Range("H2").Resize(1025, 6).Value = arr
Application.ScreenUpdating = True
End Sub
Note: The upper bound of the array can be reduced from 1025 since we are no longer using as many rows. If you require additional combinations, you can add a third number to any of the pairs.
An Example:
How to input the combination numbers
Sub Combs()
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long
Dim i As Long, arr(1 To 1025, 1 To 6) As Long
Dim grp() As Variant
grp = Range("B1:E6").Value 'Increasing the width
For a = 1 To 2
For b = 1 To 2
For c = 1 To 4 'Changed from 2 to 4
For d = 1 To 4 'Changed from 2 to 4
For e = 1 To 4 'Changed from 2 to 4
For f = 1 To 4 'Changed from 2 to 4
i = i + 1
arr(i, 1) = grp(1, a)
arr(i, 2) = grp(2, b)
arr(i, 3) = grp(3, c)
arr(i, 4) = grp(4, d)
arr(i, 5) = grp(5, e)
arr(i, 6) = grp(6, f)
Next f
Next e
Next d
Next c
Next b
Next a
Application.ScreenUpdating = False
Range("H2").Resize(1025, 6).Value = arr
Application.ScreenUpdating = True
End Sub

Answer 3

After reading your comments I think I better understand what you are looking for. It sounds like you want the combination to be a subset of six numbers from a set of ten. And each of those ten numbers is one of two values. If I understand that correctly, your issue is that you are having trouble iterating the six columns from the set of ten.
I replaced four of your For Loops with one that loops through the columns instead:
Sub Combs()
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, alt As Long
Dim i As Long, arr(1 To 1025, 1 To 6) As Long
Dim grp() As Variant
grp = Range("B1:c10").Value
For a = 1 To 2
For b = 1 To 2
For c = 1 To 2
For d = 1 To 2
For e = 1 To 2
For f = 1 To 2
For alt = 0 To 4
'Interating the used section through the full 10 columns.
'Only six columns are used in each combo, but we change which six are used from those 10
i = i + 1
arr(i, 1) = grp(1 + alt, a)
arr(i, 2) = grp(2 + alt, b)
arr(i, 3) = grp(3 + alt, c)
arr(i, 4) = grp(4 + alt, d)
arr(i, 5) = grp(5 + alt, e)
arr(i, 6) = grp(6 + alt, f)
Next alt
Next f
Next e
Next d
Next c
Next b
Next a
Application.ScreenUpdating = False
Range("H2").Resize(1025, 6).Value = arr
Application.ScreenUpdating = True
End Sub
Note: This produces 320 unique combinations. This is not all possible combinations with these number pairs, for a more complete list, you could add in additional arrays with column positions swapped.