Mati44
03-21-2021, 04:04 AM
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: https://1drv.ms/x/s!AoGkZUHlKui9gTjXXYF7IMAFfQW9?e=pqklc3
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: https://1drv.ms/x/s!AoGkZUHlKui9gTjXXYF7IMAFfQW9?e=pqklc3