PDA

View Full Version : [SOLVED] find all combinations (no repeats)



TrippyTom
02-17-2011, 04:59 PM
I'm trying to figure out a way to list all possible combinations (no repeats) of any list of items (I'm using numbers for now to make it simpler). Anything beyond 16 items would be too many rows for Excel to display. 16 items = (2^16)-1 = 65535 possible combinations (rows)

By no repeats, i mean: 1,2,3 and 2,3,1 would be the same item combination (not 2 different ones).

Anyway, I've attached the file as it is so far, but I'm missing the part where it actually outputs the subsets, like sets of 2, sets of 3, etc. I would like the output to start in F1 and go down.

I have searched this site and google all day with very little promising results. There's a ton of samples, but none of them showed a general formula or code that would handle this type of thing.

Can anyone walk me through this? This is not homework. I'm doing this as a curious experiment because I had the need to show all possible combinations (by using different colored dots on a map) at work and had to do it in my head. I knew there had to be an easier way.

If there's a solution via formulas instead of VBA I would like to see how that would work too. Also, my mapping program allows me to query things with SQL. If any SQL expert out there knows of a way to do this automatically via SQL, that'd be awesome too. :)

Thanks,
Tom

Paul_Hossler
02-17-2011, 06:23 PM
Anything beyond 16 items would be too many rows for Excel to display. 16 items = (2^16)-1 = 65535 possible combinations (rows)


The number of combanations of 18 items, taken 9 at a time

C(18,9) = 48,620

C(19,9) = 92,378

so you could get a few more and not exceed the 2003 row limit

But I'm not sure what you want running down the rows?

For ex for C(4,2) = 6, were you looking for something like

1,2
1,3
1,4
2,3
2,4
3,4

Paul

TrippyTom
02-18-2011, 09:14 AM
Yes, but i want to do that for all sets, not just combinations of 9 at a time.

For instance, say I have a set of 3 numbers: (1,2,3)
Sets of 1 number each = 3 possibles
Sets of 2 numbers each = 3 possibles
Sets of 3 numbers each = 1 possible

Added up that would be 7 possibles but i want to show them all, either with commas like you have above, or each number in its own cell, going down however many rows it would take (in this case 7 rows). I hope that makes sense? :)

Paul_Hossler
02-18-2011, 10:02 AM
Yes, but i want to do that for all sets, not just combinations of 9 at a time.


Yes, I meant that it seems like you can do up to 18 and not 16 before you run out of rows

I did a prelim last night very small amount of data with max = 4

So I came up with 4 columns the way I was playing around (for N = 4)

C(4,1)__C(4,2)___C(4,3)___C(4,4)
1______1,2_______1,2,3___1,2,3,4
2______1,3_______1,2,4
3 _____1,4_______1,3,4
4 _____2,3_______2,3,4
_______2,4
_______3,4

I set it up so that I could just input N and it will (eventually) generate the N columns and the 'whole bunch of' rows (that's a technical Excel term :) )

It's an interesting problem

Paul

TrippyTom
02-18-2011, 02:34 PM
Oh! :) I was putting them all in 1 column. I didn't think to put the sets in different columns like you did. I guess that's why I came up with the limit at 16.

I'd appreciate if you could walk me through how you did it, or show the code. Thanks!

TrippyTom
02-18-2011, 02:36 PM
sorry, image didn't come through. here it is.

GTO
02-18-2011, 02:59 PM
Hi Tom,

Have you looked at Tushar Mehta's work?

http://www.tushar-mehta.com/excel/tips/powerset.html

Very quickly put together, and early bound, but using several of his functions from the above link... Does this help at all?


Option Explicit

Sub exa()
Dim FSO As FileSystemObject
Dim FIL As TextStream

Dim a, b
Dim i As Long, n As Long

Set FSO = New FileSystemObject
Set FIL = FSO.CreateTextFile(ThisWorkbook.Path & "\Test.txt")

a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17)

For i = LBound(a) To UBound(a)
b = createCombinations(a, i + 1, ",")
For n = LBound(b) To UBound(b)
FIL.WriteLine b(n)
Next
Next
FIL.Close
End Sub

Public Function createCombinations(Arr, NbrItems As Integer, Delim As String)
createCombinations = createSubset(Arr, NbrItems, Delim)
End Function

Public Function createSubset(Arr, NbrItems As Integer, Delim As String)
Dim Rslt
ReDim Rslt(0)

aSubset Arr, LBound(Arr), NbrItems, Delim, "", Rslt
ReDim Preserve Rslt(UBound(Rslt) - 1)
'Debug.Assert NbrElements(Rslt) = _
Application.WorksheetFunction.Combin(NbrElements(Arr), NbrItems)
createSubset = Rslt
End Function

Private Sub aSubset(Arr, CurrIdx, NbrItems, ByVal Delim As String, _
ByVal PreString As String, ByRef Rslt)
Dim i As Integer
If NbrItems = 0 Then
If PreString = "" Then Rslt(UBound(Rslt)) = PreString _
Else Rslt(UBound(Rslt)) = Left(PreString, Len(PreString) - Len(Delim))
ReDim Preserve Rslt(UBound(Rslt) + 1)
Else
For i = CurrIdx To NbrElements(Arr) - NbrItems + LBound(Arr)
aSubset Arr, i + 1, NbrItems - 1, Delim, _
PreString & Arr(i) & Delim, Rslt
Next i
End If
End Sub

Private Function NbrElements(Arr) As Integer
On Error Resume Next
NbrElements = UBound(Arr) - LBound(Arr) + 1
End Function

Mark

Paul_Hossler
02-19-2011, 11:52 AM
My effort


Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim aData() As Variant
Dim bDone As Boolean
iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub
'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
ReDim aData(1 To iNumber)
For i = 1 To iNumber
aData(i) = i
Next i
'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents
'columns = C(iNumber, iCol)
For iCol = 1 To iNumber
'start in first row of iCol
iRow = 1
'add C(N, iCol) as header
ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"
Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next I
Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
s = aData(i) & ","
Next I
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"
Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = I
aIndex(i, 2) = iNumber - iCol + I
Next I
bDone = False
While Not bDone
'do first one
s = aData(aIndex(1, 1))
For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next I
iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"
If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 1 Then GoTo NextCol
Wend
'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1
For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next I
End If
'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend
End Select
NextCol:
Next iCol
End Sub


There's a little more brute force ('inelagance') than I'd like, so maybe some others can offer clean up suggestions


Paul

Paul_Hossler
02-19-2011, 08:08 PM
I think I must have posted an imternediate version

That does NOT do what I had it doing before

I'll have to track down my working version

That one doesn't finish all the combinations

Really sorry about that

Paul

Paul_Hossler
02-19-2011, 08:19 PM
Dumb mistake - I was working in 2010 and made changes to my 2010 .xlsm after I back-saved in it 2003 .xls format

Only difference was changing the test in the j loop


Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim aData() As Variant
Dim bDone As Boolean
iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub
'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
ReDim aData(1 To iNumber)
For i = 1 To iNumber
aData(i) = i
Next i
'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents
'columns = C(iNumber, iCol)
For iCol = 1 To iNumber
'start in first row of iCol
iRow = 1
'add C(N, iCol) as header
ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"
Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next I
Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
s = aData(i) & ","
Next I
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"
Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = I
aIndex(i, 2) = iNumber - iCol + I
Next I
bDone = False
While Not bDone
'do first one
s = aData(aIndex(1, 1))
For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next I
iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"
If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 0 Then GoTo NextCol ' <<<<<<<<<
Wend
'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1
For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next I
End If
'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend
End Select
NextCol:
Next iCol
End Sub


Paul

Paul_Hossler
02-20-2011, 06:41 AM
I thought that there was an other problem that I had found/fixed :doh:

I figure it'd be easier to just make the VBA change if you're interested



Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
s = s & aData(i) & "," ' <<<<<<<<<
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"


Paul

PAB
05-25-2016, 05:04 AM
Good afternoon Paul,

I know this is an old tread, 02-20-2011, 02:41 PM, but I came across it while searching Google.

I have been trying to adapt the code to put the total number of combinations produced for each distribution directly after the last entry for each distribution. I just can't seem to get it quite right though.

This is what I am using for Case 1...


ActiveSheet.Cells(i + 2, iCol).Value = Application.Count(aData(i))

...and this is what I am using for Case iNumber...


ActiveSheet.Cells(3, iCol).Value = Application.CountA(aData(iNumber))

...any help will be appreciated.

Thanks in advance.

Paul_Hossler
05-25-2016, 05:45 AM
If I'm understanding, adding these 3 lines towards the end




NextCol:

With ActiveSheet.Cells(1, iCol).End(xlDown).Offset(1, 0)
.Value = (.Row - 2) & " Comb"
End With

Next iCol
End Sub

PAB
05-25-2016, 06:03 AM
Spot on Paul, thanks very much.

sanchit22
07-27-2016, 01:43 AM
I'm trying to figure out a way to list all possible combinations (no repeats) of any list of items (I'm using numbers for now to make it simpler). Anything beyond 16 items would be too many rows for Excel to display. 16 items = (2^16)-1 = 65535 possible combinations (rows)

By no repeats, i mean: 1,2,3 and 2,3,1 would be the same item combination (not 2 different ones).

Anyway, I've attached the file as it is so far, but I'm missing the part where it actually outputs the subsets, like sets of 2, sets of 3, etc. I would like the output to start in F1 and go down.

I have searched this site and google all day with very little promising results. There's a ton of samples, but none of them showed a general formula or code that would handle this type of thing.

Can anyone walk me through this? This is not homework. I'm doing this as a curious experiment because I had the need to show all possible combinations (by using different colored dots on a map) at work and had to do it in my head. I knew there had to be an easier way.

If there's a solution via formulas instead of VBA I would like to see how that would work too. Also, my mapping program allows me to query things with SQL. If any SQL expert out there knows of a way to do this automatically via SQL, that'd be awesome too. :)

Thanks,
Tom

sanchit22
07-27-2016, 01:44 AM
I have ten columns, each column has five rows in them. Each row has one word, I need to list out combinations without repetition using these ten column and 5 rows in each column. One element to be taken from one column at a time. Each combination will have five elements, one from each column. Please help me how to do this.

chrz1393
03-16-2017, 12:31 PM
I was also looking for a answer to this question. Thanks.


Dumb mistake - I was working in 2010 and made changes to my 2010 .xlsm after I back-saved in it 2003 .xls format

Only difference was changing the test in the j loop


Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim aData() As Variant
Dim bDone As Boolean


iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub


'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
ReDim aData(1 To iNumber)
For i = 1 To iNumber
aData(i) = i
Next i



'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents

'columns = C(iNumber, iCol)
For iCol = 1 To iNumber

'start in first row of iCol
iRow = 1

'add C(N, iCol) as header
ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"


Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next i

Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
s = aData(i) & ","
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"

Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = i
aIndex(i, 2) = iNumber - iCol + i
Next i

bDone = False

While Not bDone

'do first one
s = aData(aIndex(1, 1))

For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next i

iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"


If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 0 Then GoTo NextCol ' <<<<<<<<<
Wend

'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1


For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next i
End If



'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend

End Select

NextCol:
Next iCol

End Sub


Paul

ober
03-19-2019, 07:53 AM
Hi Paul,
I've tried use the below but for "aData(i) = Array("5L", "5R", "4L", "4R", "3L", "3R", "B2", "B3", "B4")" as this is exactly what I need to find however it's not seems to be working. VBA is new to me so going through trial and error here. Would you be able to point what I'm doing wrong please?


My effort


Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim aData() As Variant
Dim bDone As Boolean


iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub


'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
ReDim aData(1 To iNumber)
For i = 1 To iNumber
aData(i) = i
Next i



'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents

'columns = C(iNumber, iCol)
For iCol = 1 To iNumber

'start in first row of iCol
iRow = 1

'add C(N, iCol) as header
ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"


Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next i

Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
s = aData(i) & ","
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"

Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = i
aIndex(i, 2) = iNumber - iCol + i
Next i

bDone = False

While Not bDone

'do first one
s = aData(aIndex(1, 1))

For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next i

iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"


If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 1 Then GoTo NextCol
Wend

'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1


For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next i
End If



'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend

End Select

NextCol:
Next iCol

End Sub


There's a little more brute force ('inelagance') than I'd like, so maybe some others can offer clean up suggestions


Paul

Paul_Hossler
03-19-2019, 08:56 AM
I didn't go through the macro, but try changing this line




aData = Array("5L", "5R", "4L", "4R", "3L", "3R", "B2", "B3", "B4")


aData(I) = … refers to just one element

Msimo
12-03-2019, 04:27 AM
Good day Sir,

Really hoping you could see this soon because this thread is pretty old but this particular response exactly describes what I am trying achieve. I am very new to VBA and have been literally surfing all day on how to achieve generating results of a number of combinations from a list of N items, taking R at a time. Too many confusing codes.

I have got a list of 15 alphabets (A - O) in a column and want to be able to combine 4 at a time.
The number of combinations for this is C(15,4) = 1365

I want the results displayed down the rows just like in your comment. Something like;

A,B,C,D
A,B,J,K
L,M,N,O
C,E,F,H

etc

Already getting a headache from attempting. Can you please be of help?

p45cal
12-03-2019, 04:56 AM
Try the likes of
Sub Blah()
Set Source = Range("A1:A15")
Set Destn = Range("B1")
For g = 1 To 12
For h = g + 1 To 13
For i = h + 1 To 14
For j = i + 1 To 15
Destn.Value = Join(Array(Source.Cells(g), Source.Cells(h), Source.Cells(i), Source.Cells(j)), ",")
Set Destn = Destn.Offset(1)
Next
Next
Next
Next
End Sub

p45cal
12-03-2019, 05:19 AM
or faster:
Sub Blah2()
Set Source = Range("A1:A15")
SceVals = Source.Value
Set Destn = Range("C1")
myCount = Application.WorksheetFunction.Combin(UBound(SceVals), 4)
ReDim Results(1 To myCount, 1 To 1)
k = 1
For g = 1 To UBound(SceVals) - 3
For h = g + 1 To UBound(SceVals) - 2
For i = h + 1 To UBound(SceVals) - 1
For j = i + 1 To UBound(SceVals)
Results(k, 1) = Join(Array(SceVals(g, 1), SceVals(h, 1), SceVals(i, 1), SceVals(j, 1)), ",")
k = k + 1
Next
Next
Next
Next
Destn.Resize(myCount).Value = Results
End Sub

snb
12-03-2019, 06:05 AM
Especially designed for you:

http://www.snb-vba.eu/VBA_Combinations_en.html

Paul_Hossler
12-03-2019, 07:10 AM
Try this




Option Explicit


Sub C15_4()
Const cA As Long = 65 ' use number values
Const cO As Long = 79 ' ASCII A = 65, ASCII O = 79

Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, o As Long

o = 1 ' starting output row

For i1 = cA To cO ' A - L
For i2 = i1 + 1 To cO
For i3 = i2 + 1 To cO
For i4 = i3 + 1 To cO
ActiveSheet.Cells(o, 1).Value = Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4)
o = o + 1
Next i4
Next i3
Next i2
Next i1


MsgBox "Done"


End Sub

Msimo
12-03-2019, 10:11 AM
THANK Y'ALL SO SO SO MUCH!!!! PROBLEM SOLVED PERFECTLY. I APPRECIATE THE HELP :yes:yes:yes

worldnew29
12-15-2019, 07:01 PM
same issue. thanks for all you guys. it's quite helpful for me so solve the problem.:thumb

NIMANIMA50
03-13-2021, 04:28 AM
Hi Paul,

I was trying to figure out an Excel VBA for combination of 6 columns of numbers. Lets say columns A-F contain numbers. I want to generate all the combination of these 6 columns without repetition and considering the criteria below for generated combination( assuming the combinations are stored in COLUMNS G-L):

G<H<I<J<K<L

I appreciated if you could help on this.

p45cal
03-13-2021, 04:46 AM
There is only one combination with those criteria.
All you need to do is sort horizontally.

NIMANIMA50
03-13-2021, 04:57 AM
There is only one combination with those criteria.
All you need to do is sort horizontally.

Hi p45cal,

I am not sure if I am following you. each columns has about 35-45 numbers. How can you get all the combinations as it is required with the method you mentioned?

p45cal
03-13-2021, 05:29 AM
OK. Maybe I've misunderstood; best attach a workbook.

NIMANIMA50
03-13-2021, 05:52 AM
OK. Maybe I've misunderstood; best attach a workbook.

p45cal,

Please see attach workbook as an example.

Thanks

p45cal
03-13-2021, 02:33 PM
You realise there are about 6.25 million combinations that meet your criteria?
(21 million+ ignoring criteria)

How do you want the results, bearing in mind there are only about 1 million rows on a sheet?

Paul_Hossler
03-13-2021, 03:55 PM
How good is your example?

1. I can see that the Green is acceptable -- G<H<I<J<K<L

2. I can see that the Orange is not acceptable -- G>H

3. Where did the Blue come from?

28097



Lets say columns A-F contain numbers. I want to generate all the combination of these 6 columns without repetition and considering the criteria below for generated combination (assuming the combinations are stored in COLUMNS G-L): G<H<I<J<K<L

I don't see where 'All Combinations' comes in

For example



1
10
24
39
45
55




can be arranged 720 ways (6!) and there's only 1 way G<H<I<J<K<L


Likewise



9
6
20
40
41
51




can be arranged 720 ways and 6-9-20-40-41-51 would be the answer

It sort of / almost / kind of looks like you just want to take 6 numbers and see if G<H<I<J<K<L, returning a Yes/No answer

NIMANIMA50
03-13-2021, 06:51 PM
You realise there are about 6.25 million combinations that meet your criteria?
(21 million+ ignoring criteria)

How do you want the results, bearing in mind there are only about 1 million rows on a sheet?

Thanks p45cal,

What I need is a VBA code to generate all those combination.

Thanks

NIMANIMA50
03-13-2021, 07:48 PM
How good is your example?

1. I can see that the Green is acceptable -- G<H<I<J<K<L

2. I can see that the Orange is not acceptable -- G>H

3. Where did the Blue come from?

28097




I don't see where 'All Combinations' comes in

For example



1
10
24
39
45
55




can be arranged 720 ways (6!) and there's only 1 way G<H<I<J<K<L


Likewise



9
6
20
40
41
51




can be arranged 720 ways and 6-9-20-40-41-51 would be the answer

It sort of / almost / kind of looks like you just want to take 6 numbers and see if G<H<I<J<K<L, returning a Yes/No answer

Paul,

I attached another file that might make the concept clearer for you. For the sake of simplicity I consider only 4 columns (note: this is an example , I need a VBA code to work for 6 columns).

Thanks

thanks

p45cal
03-14-2021, 01:18 AM
What I need is a VBA code to generate all those combination.

I've done that, so again:
You realise there are about 6.25 million combinations that meet your criteria?
How do you want the results, bearing in mind there are only about 1 million rows on a sheet?

NIMANIMA50
03-14-2021, 01:38 AM
I've done that, so sgain:

p45cal ,

can we split the result in 7 or or worksheets/ workbooks?

thanks

p45cal
03-14-2021, 04:22 AM
In the attached is a button in the vicinity of cell J8.
Here, it takes the code about 5 seconds to get the 6.25 million results, about 40 secs to write them to the sheets.

Note that there is nothing in the code to eliminate repeats; at the moment there are none because none of the individual source columns contain any duplicates. If duplicates do occur in the original columns the code will need a tweak.

NIMANIMA50
03-14-2021, 04:38 AM
In the attached is a button in the vicinity of cell J8.
Here, it takes the code about 5 seconds to get the 6.25 million results, about 40 secs to write them to the sheets.

THANKS A LOT P45CAL. Seems working perfectly.

p45cal
03-14-2021, 04:42 AM
What on earth are you going to do with 6.25 million rows of data?!

Paul_Hossler
03-14-2021, 08:03 AM
I sort of understand, but to p45cal's comment ...


What on earth are you going to do with 6.25 million rows of data?!


it would seem to me that just listing the acceptable combinations would be better

p45cal
03-14-2021, 08:21 AM
it would seem to me that just listing the acceptable combinations would be better
If I've understood what Paul means by acceptable combinations, my 6.25 million rows are the acceptable ones, the macro has excluded some 13 million already!
What on earth can a human do with more than 6 million rows of data - I'd have difficulty handling 10 rows!

Paul_Hossler
03-14-2021, 09:37 AM
I was just scratching my head over the simplified Book2 example in post #35

28105

There were 12 'results', but only one was 'Acceptable' (approx 8%). It appeared to be more a traverse problem to find an acceptable path than a combinations problem. Guess I was wrong

In the full example and using p45cal's macro the 6 columns of numbers look like there would be 14 x 19 x 19 x19 x20 x 11 = 21,125,720 to be checked, with 6,247,034 Acceptable (approx 30%)


Edit:


I'm still wondering what 6M+ results could be used for

NIMANIMA50
03-16-2021, 10:09 PM
Hi p45cal,

Could you please have a look at the attached excel file as an example28117. I have left a note about the criteria.

Thanks

p45cal
03-17-2021, 09:40 AM
There are about 40 million 'acceptable' combinations.
Output is to the Immediate pane:
Sub blah()
For a = 1 To 53
For b = 2 To 54
If b > a Then
For c = 3 To 55
If c > b Then
For d = 4 To 56
If d > c Then
For e = 5 To 57
If e > d Then
For f = 6 To 58
If f > e Then
Debug.Print a, b, c, d, e, f
End If
Next f
End If
Next e
End If
Next d
End If
Next c
End If
Next b
Next a
End Sub

NIMANIMA50
03-17-2021, 04:10 PM
There are about 40 million 'acceptable' combinations.
Output is to the Immediate pane:
Sub blah()
For a = 1 To 53
For b = 2 To 54
If b > a Then
For c = 3 To 55
If c > b Then
For d = 4 To 56
If d > c Then
For e = 5 To 57
If e > d Then
For f = 6 To 58
If f > e Then
Debug.Print a, b, c, d, e, f
End If
Next f
End If
Next e
End If
Next d
End If
Next c
End If
Next b
Next a
End Sub


P45cal,

Thank you for your response. However there are some issues with your code.
1. it considers the numbers in DATA columns as fixed (1-58) but this columns has variable and mixed numbers (My fault I did not clearly explained at first).
2. I tried to run the code but Excel got frozen so I have to close it, but by looking at the code, it tries to list all combination in one sheet and separated by ",". I need the combinations to be placed in different cells (for instant A-F) and if can not fit in one sheet it will be split in different sheets (workbooks preferably) , like your previous code.
I have attached another file , I hope this file will be clear.

Thanks again

Paul_Hossler
03-17-2021, 04:52 PM
I think it's easier to generate combinations down to row 1M and then move over 7 columns for the next 1M instead of messing with adding worksheets / workbooks (just my 2 cents)

28123


This just does data in the same order as it's listed in Col A and will get messed up if a number is repeated in Data



Option Explicit


Sub Generate()
Dim r As Range
Dim v As Variant
Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long, n6 As Long
Dim rowCount As Long, colCount As Long
Dim N As Long

With Worksheets("Sheet2")
Set r = .Range("A1")
Set r = Range(r, r.End(xlDown))

v = Application.WorksheetFunction.Transpose(r)
N = UBound(v)

rowCount = 1
colCount = 3

For n1 = 1 To N - 5
For n2 = n1 + 1 To N - 4
For n3 = n2 + 1 To N - 3
For n4 = n3 + 1 To N - 2
For n5 = n4 + 1 To N - 1
For n6 = n5 + 1 To N
.Cells(rowCount, colCount).Value = v(n1)
.Cells(rowCount, colCount + 1).Value = v(n2)
.Cells(rowCount, colCount + 2).Value = v(n3)
.Cells(rowCount, colCount + 3).Value = v(n4)
.Cells(rowCount, colCount + 4).Value = v(n5)
.Cells(rowCount, colCount + 5).Value = v(n6)

rowCount = rowCount + 1

If rowCount Mod 1000 = 0 Then
Application.StatusBar = v(n1) & "," & v(n2) & "," & v(n3) & "," & v(n4) & "," & v(n5) & "," & v(n6)
DoEvents
End If

If rowCount = 1000001 Then
rowCount = 1
colCount = colCount + 7
End If
Next n6
Next n5
Next n4
Next n3
Next n2
Next n1
End With

Application.StatusBar = False

MsgBox "Done"

End Sub

NIMANIMA50
03-17-2021, 05:19 PM
I think it's easier to generate combinations down to row 1M and then move over 7 columns for the next 1M instead of messing with adding worksheets / workbooks (just my 2 cents)

28123


This just does data in the same order as it's listed in Col A and will get messed up if a number is repeated in Data



Option Explicit


Sub Generate()
Dim r As Range
Dim v As Variant
Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long, n6 As Long
Dim rowCount As Long, colCount As Long
Dim N As Long

With Worksheets("Sheet2")
Set r = .Range("A1")
Set r = Range(r, r.End(xlDown))

v = Application.WorksheetFunction.Transpose(r)
N = UBound(v)

rowCount = 1
colCount = 3

For n1 = 1 To N - 5
For n2 = n1 + 1 To N - 4
For n3 = n2 + 1 To N - 3
For n4 = n3 + 1 To N - 2
For n5 = n4 + 1 To N - 1
For n6 = n5 + 1 To N
.Cells(rowCount, colCount).Value = v(n1)
.Cells(rowCount, colCount + 1).Value = v(n2)
.Cells(rowCount, colCount + 2).Value = v(n3)
.Cells(rowCount, colCount + 3).Value = v(n4)
.Cells(rowCount, colCount + 4).Value = v(n5)
.Cells(rowCount, colCount + 5).Value = v(n6)

rowCount = rowCount + 1

If rowCount Mod 1000 = 0 Then
Application.StatusBar = v(n1) & "," & v(n2) & "," & v(n3) & "," & v(n4) & "," & v(n5) & "," & v(n6)
DoEvents
End If

If rowCount = 1000001 Then
rowCount = 1
colCount = colCount + 7
End If
Next n6
Next n5
Next n4
Next n3
Next n2
Next n1
End With

Application.StatusBar = False

MsgBox "Done"

End Sub




Thanks Paul,
I , however , prefer splitting the combination into different workbooks rather than sheets (or within one sheet). Having different workbooks will make working with the data much easier compared to when they all in one big heavy file.

Paul_Hossler
03-17-2021, 05:28 PM
Write a second macro to take each million row chunk and put into a separate workbook, although I still fail to see how 40 x 10^6 six-tuples would ever be easy to work with.

Did you ever say just what the ultimate purpose was, or did I miss it?

p45cal
03-17-2021, 06:21 PM
This is ludicrous.

1. Since the values don't have to increase any more from left to right, are (for example) both
1,2,3,4,5,6
and
1,2,3,4,6,5
required in the list?
(just the last 2 numbers are switched)

2. Will the starting column of numbers contain duplicates?

NIMANIMA50
03-17-2021, 06:52 PM
This is ludicrous.

1. Since the values don't have to increase any more from left to right, are (for example) both
1,2,3,4,5,6
and
1,2,3,4,6,5
required in the list?
(just the last 2 numbers are switched)

2. Will the starting column of numbers contain duplicates?

p45cal,

The order of combination is not required. as you said, 1,2,3,4,5,6 and 1,2,3,4,6,5 are the same and only one needs to be listed.
this is just combination without repetition that we use this formula to calculate the total number of combination.28125
in this case k=6 and n is variable depends on the count of numbers in column "DATA".

p45cal
03-18-2021, 01:47 AM
Again,
2. Will the starting column of numbers contain duplicates?

NIMANIMA50
03-18-2021, 01:59 AM
Again,

I dont understand your question. can you give an example?

p45cal
03-18-2021, 02:32 AM
I dont understand your question. can you give an example?

28128

NIMANIMA50
03-18-2021, 02:55 AM
28128

It doesn't matter as long as no duplicate in the combination

p45cal
03-18-2021, 03:19 AM
It doesn't matter as long as no duplicate in the combinationI'll take that as a yes. It does matter because it needs to be catered for in the code you're asking for; it just means that the process of finding the combinations could be a lot longer, or that we have to do some deduplicating before searching for combinations.

Paul_Hossler
03-18-2021, 08:25 AM
I'll take that as a yes. It does matter because it needs to be catered for in the code you're asking for; it just means that the process of finding the combinations could be a lot longer, or that we have to do some deduplicating before searching for combinations.

Sorting low-to-high probably wouldn't hurt either

p45cal
03-18-2021, 12:44 PM
Try the attached.

NIMANIMA50
03-20-2021, 01:15 AM
Try the attached.

I tried the list in the attached file but nothing generated.

p45cal
03-20-2021, 03:45 AM
Your last attachment works fine here. You'll have to wait a bit.
If you want to reassure yourself that it's working, change the line:
ResultBlockSize = 1000000
to say:
ResultBlockSize = 100000
which should produce some 24 new workbooks with your data.

I'm presuming the file I attached to msg#58 worked OK.

NIMANIMA50
03-20-2021, 04:49 AM
Your last attachment works fine here. You'll have to wait a bit.
If you want to reassure yourself that it's working, change the line:
ResultBlockSize = 1000000
to say:
ResultBlockSize = 100000
which should produce some 24 new workbooks with your data.

I'm presuming the file I attached to msg#58 worked OK.

Yes, you are right. I waited for 6 minutes to generate 3 workbooks. Is it possible to improve the speed without decreasing the ResultBlockSize?

p45cal
03-20-2021, 05:15 AM
Decreasing ResultBlockSize doesn't speed it up, it slows it down because it has to create more workbooks. You can increase it safely up to 1,048,574
There is a DoEvents line whichyou can take out, but this will make it very difficult to interrupt the code should you find you've given it a task which is too big and so is taking too long.
Otherwise, there's not much to do to speed it up further.
So far you've been reluctant to say what you're going to do with these results, which could have a bearing on how/how quickly they can be produced.

edit: Taking DoEvents out speeds it up almost 10 times!

NIMANIMA50
03-20-2021, 05:31 AM
Decreasing ResultBlockSize doesn't speed it up, it slows it down because it has to create more workbooks. You can increase it safely up to 1,048,574
There is a DoEvents line whichyou can take out, but this will make it very difficult to interrupt the code should you find you've given it a task which is too big and so is taking too long.
Otherwise, there's not much to do to speed it up further.
So far you've been reluctant to say what you're going to do with these results, which could have a bearing on how/how quickly they can be produced.

I am doing a study on the analysis of chaotic data.

SamT
03-20-2021, 01:45 PM
Chaotic Data without repetitions is not Chaotic

If a 6 column Row of numbers is one Chaotic Data Point, then 1234,65 is not the same as 1234,56

IMO, you are making your "Chaotic" Data Set very regulated.

NIMANIMA50
03-20-2021, 05:00 PM
Chaotic Data without repetitions is not Chaotic

If a 6 column Row of numbers is one Chaotic Data Point, then 1234,65 is not the same as 1234,56

IMO, you are making your "Chaotic" Data Set very regulated.

if you want to study something you need to do it in phases before putting everything in the bowl and getting confused what could cause a certain behavior. Then you can widen your range and explore more.

Paul_Hossler
03-20-2021, 06:13 PM
http://sprott.physics.wisc.edu/cdg.htm




28148


Like SamT says:


IMO, you are making your "Chaotic" Data Set very regulated.


In my layman's terms, the best exmple of 'choas' is the classic butterfly effect.



In chaos theory (https://en.wikipedia.org/wiki/Chaos_theory), the butterfly effect is the sensitive dependence on initial conditions (https://en.wikipedia.org/wiki/Initial_condition) in which a small change in one state of a deterministic (https://en.wikipedia.org/wiki/Deterministic_system) nonlinear system (https://en.wikipedia.org/wiki/Nonlinear_system) can result in large differences in a later state.The term is closely associated with the work of mathematician and meteorologist Edward Lorenz (https://en.wikipedia.org/wiki/Edward_Lorenz). He noted that butterfly effect is derived from the metaphorical example of the details of a tornado (the exact time of formation, the exact path taken) being influenced by minor perturbations such as a distant butterfly (https://en.wikipedia.org/wiki/Butterfly) flapping its wings several weeks earlier. Lorenz discovered the effect when he observed runs of his weather model (https://en.wikipedia.org/wiki/Numerical_weather_prediction) with initial condition data that were rounded in a seemingly inconsequential manner. He noted that the weather model (https://en.wikipedia.org/wiki/Numerical_weather_prediction) would fail to reproduce the results of runs with the unrounded initial condition data. A very small change in initial conditions had created a significantly different outcome.[1] (https://en.wikipedia.org/wiki/Butterfly_effect#cite_note-1)


The idea that small causes may have large effects in weather was earlier recognized by French mathematician and engineer Henri Poincaré (https://en.wikipedia.org/wiki/Henri_Poincar%C3%A9). American mathematician and philosopher Norbert Wiener (https://en.wikipedia.org/wiki/Norbert_Wiener) also contributed to this theory. Edward Lorenz (https://en.wikipedia.org/wiki/Edward_Norton_Lorenz)'s work placed the concept of instability of the Earth's atmosphere (https://en.wikipedia.org/wiki/Atmosphere) onto a quantitative base and linked the concept of instability to the properties of large classes of dynamic systems which are undergoing nonlinear dynamics (https://en.wikipedia.org/wiki/Nonlinear_dynamics) and deterministic chaos (https://en.wikipedia.org/wiki/Chaos_theory).[2] (https://en.wikipedia.org/wiki/Butterfly_effect#cite_note-scholarpedia-2)

SamT
03-21-2021, 01:31 AM
Function Chaotic() As Long
'Returns 2 digit number
Randomize
Chaotic = CLong(Rnd() * 100)
End Function

'May be faster
Function Chaotic2() As Long
'Returns 2 digit number: final *100
Chaotic = CLong(Rnd(CInt(Right(CStr(CDble(Now)), 3) * -1) * 100))
End Function

Paul_Hossler
03-21-2021, 07:52 AM
SamT -- I would say that IMVVVHO is more of a Monte Carlo approach


I was thinking (again, it's been a long time for me) that testing a model through 1000's of iterations using an inputs of t-sub0 = 1.00001 and t-sub0 = 1.000011 to see the differences at the would be closer to the butterfly effect