PDA

View Full Version : List out all possible combination in the sheet



scrusader
06-23-2011, 11:57 PM
Hi,

How to list out all the possible combination of data in a worksheet?

For example, the user insert like this
A........ B....... C
D.................. E
.....................F

after user click a button
if become
A B C
A B E
A B F
D B C
D B E
D B F

Kenneth Hobs
06-24-2011, 05:29 AM
Welcome to the forum!

Obviously, there are 10 combinations. The attachment is fairly straightforward. Select A1 and click the button. I have already added the inputs for you. It will add a new sheet with output in the format of:
A, B, C
A, B, D
etc.

Paul_Hossler
06-25-2011, 10:36 AM
Actually I think there's only 6 if the first char in the triplet has to be A or D, the second char has to be B, and the third has to be C or E or F

2 x 1 x 3

This might not be the best way, but it's one way


Option Explicit

Sub Combines()
Dim rData As Range
Dim N As Long
Dim iCol As Long, iRow As Long, i As Long
Dim A() As String
Dim M() As Long

'save the working range
Set rData = ActiveSheet.Cells(1, 1).CurrentRegion

'save number in each column
ReDim M(1 To rData.Columns.Count)
For iCol = 1 To rData.Columns.Count
If rData.Cells(1, iCol).End(xlDown).Row = rData.Parent.Rows.Count Then
M(iCol) = 1
Else
M(iCol) = rData.Cells(1, iCol).End(xlDown).Row
End If
Next iCol

'find total number of combanations
N = 1
For iCol = 1 To rData.Columns.Count
N = N * M(iCol)
Next iCol

'create working array
ReDim A(1 To N, 1 To rData.Columns.Count)
'fill working array
For iCol = 1 To UBound(A, 2)
For iRow = 1 To UBound(A, 1)
A(iRow, iCol) = rData.Cells((iRow + 1) Mod M(iCol) + 1, iCol).Value
Next iRow
Next iCol

'display it on the column 2 over
For iRow = 1 To UBound(A, 1)
For iCol = 1 To UBound(A, 2)
rData.Cells(iRow, UBound(A, 2) + 2).Value = rData.Cells(iRow, UBound(A, 2) + 2).Value & A(iRow, iCol)
Next iCol
Next iRow

'sort to make pretty
rData.Cells(1, UBound(A, 2) + 2).CurrentRegion.Select
With rData.Parent.Sort
.SortFields.Clear
.SortFields.Add Key:=rData.Cells(1, UBound(A, 2) + 2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rData.Cells(1, UBound(A, 2) + 2).CurrentRegion
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub


Paul

scrusader
06-26-2011, 07:32 PM
Thanks for the reply guys.
Sorry for the trouble but Paul when i have more than 1 row for the column containing the letter "b", it will still only process that column for 1 time . Is there method to solve it?

if it is like this
A........ B....... C
D.........E....... F
.....................G

it will become it will display ABC , ABC , ABF , ABF, ABG, ABG instead of ABC , AEC , ABF , AEF, ABG, AEG

Paul_Hossler
06-27-2011, 10:49 AM
I should have used more complicated data

Try this one. Not a elegant since I couldn't use Mod like I wanted to :whistle:


Option Explicit
Sub Combines()
Dim rData As Range
Dim N As Long, N1 As Long

Dim iCol As Long, iRow As Long
Dim A() As String
Dim M() As Long, iM() As Long

'save the working range
Set rData = Worksheets("sheet1").Cells(1, 1).CurrentRegion

'save number in each column
ReDim M(1 To rData.Columns.Count)
ReDim iM(1 To rData.Columns.Count)
For iCol = 1 To rData.Columns.Count
If rData.Cells(1, iCol).End(xlDown).Row = rData.Parent.Rows.Count Then
M(iCol) = 1
Else
M(iCol) = rData.Cells(1, iCol).End(xlDown).Row
End If
Next iCol
'find total number of combinations, and init counter array
N = 1
For iCol = 1 To rData.Columns.Count
N = N * M(iCol)
iM(iCol) = 1
Next iCol
'create working array
ReDim A(1 To N, 1 To rData.Columns.Count)

'fill working array
N1 = N

For iCol = 1 To UBound(A, 2)

N1 = N1 / M(iCol)

i = 0

For iRow = 1 To UBound(A, 1)

A(iRow, iCol) = rData.Cells(iM(iCol), iCol).Value

i = i + 1

If i = N1 Then
iM(iCol) = iM(iCol) + 1
If iM(iCol) > M(iCol) Then iM(iCol) = 1
i = 0
End If

Next iRow

Next iCol

'display it on the column 2 over
For iRow = 1 To UBound(A, 1)
For iCol = 1 To UBound(A, 2)
rData.Cells(iRow, UBound(A, 2) + 2).Value = rData.Cells(iRow, UBound(A, 2) + 2).Value & A(iRow, iCol)
Next iCol
Next iRow
End Sub


Paul