Need to derive combinations for 4 elements each with 3 possible va
 

I have four data elements and each can have one of three possible data values
at any one point in time. How can I auto-generate in excel, the various
possible data value combinations/mixes that I can get for these four items?
Assume the data elements are 1, 2, 3 & 4 and that the possible values are a,
b & c. Any help would be greatly appreciated.

Need to derive combinations for 4 elements each with 3 possible va
 

1) List out the 12 combinations for
1a,1b,1c,2a,2b,2c,3a,3b,3c,4a,4b,4c
This will derive 4,096 combinations (2^12)

The macro listed below will create a worksheet with all 4,096 combinations.
I use it for check reconciliations at works. I currently have it set up for
15 selections or less because 2^15 = 32,768 and I didn't want to deal with
wrapping into more columns.

HTH,
Gary Brown

If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".

'/=================================================/
Sub Combos()
'This program will give the addition of each combination
' of cells selected
'The # of combinations is calculated as
' [2^(# of cells selected)] - 1
'
On Error Resume Next
Dim aryHiddensheets()
Dim aryNum() As Double, aryExp() As String
Dim aryA()
Dim dblLastRow As Double, dblRow As Double
Dim i As Double
Dim x As Integer, iMaxCount As Integer
Dim z As Integer, r As Integer
Dim y As Integer, iWorksheets As Integer
Dim iCol As Integer
Dim iCount As Integer
Dim objCell As Object
Dim rngInput As Range
Dim strOriginalAddress As String
Dim strRngInputAddress As String
Dim strWorksheetName As String
Dim strResultsTableName As String
Dim varAnswer As Variant

'/----------start-up Variables-------------/
strResultsTableName = "Combinations_Listing"
strOriginalAddress = Selection.Address
strWorksheetName = ActiveSheet.Name
iMaxCount = 15
'/----------end start-up Variables---------/

Set rngInput = _
Application.InputBox(Prompt:= _
"Select Range of Numbers to be used as input for " & _
"combinations output" & vbCr & vbCr & _
"Note: Currently limited to " & _
iMaxCount & " cells or less", _
Title:="Combinations....", _
Default:=strOriginalAddress, Type:=8)

'get how many cells have been selected and location
iCount = rngInput.Count
strRngInputAddress = rngInput.Address

Select Case iCount
Case 0
MsgBox "No cells have been selected." & vbCr & _
vbCr & "Process aborted...", _
vbExclamation + vbOKOnly, _
"Warning..."
GoTo exit_Sub
Case 1 To iMaxCount
i = (2 ^ iCount) - 1
varAnswer = MsgBox("The " & iCount & _
" selected cell(s) will produce " & _
Application.WorksheetFunction.Text(i, "#,##") & _
" combinations." & vbCr & "Do you wish to continue?", _
vbInformation + vbYesNo, _
"Combinations...")
If varAnswer = vbNo Then Exit Sub
Case Is iMaxCount
varAnswer = _
MsgBox("Only the first " & iMaxCount & _
" cells in the range <<< " & _
strRngInputAddress & " will be processed." & vbCr & _
vbCr & "Continue?", vbExclamation + vbYesNo, "Warning")
If varAnswer = vbNo Then Exit Sub
End Select

If iCount iMaxCount Then iCount = iMaxCount

'now that we can calculate the actual dimensions
' we can re-dimension the arrays
ReDim aryNum(1 To iCount)
ReDim aryA(1 To ((2 ^ iCount) - 1), 1 To 2)
ReDim aryExp(1 To iCount)

'populate the array with the values in the selected cells
i = 0
For Each objCell In rngInput
i = i + 1
If i iMaxCount Then Exit For
aryNum(i) = objCell.Value
aryExp(i) = _
Application.WorksheetFunction.Text(objCell.Value, "@")
Next objCell

'Count number of worksheets in workbook
iWorksheets = ActiveWorkbook.Sheets.Count

'redim array
ReDim aryHiddensheets(1 To iWorksheets)

'put hidden sheets in an array, then unhide the sheets
For x = 1 To iWorksheets
If Worksheets(x).Visible = False Then
aryHiddensheets(x) = Worksheets(x).Name
Worksheets(x).Visible = True
End If
Next

'Check for duplicate Worksheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If UCase(Worksheets(x).Name) = _
UCase(strResultsTableName) Then
Worksheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Exit For
End If
Next

'Add new worksheet at end of workbook
' where results will be located
Worksheets.Add.Move After:=Worksheets(ActiveSheet.Name)

'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.Name = strResultsTableName
ActiveWorkbook.ActiveSheet.Range("A1").Value = "Amount"
ActiveWorkbook.ActiveSheet.Range("B1").Value = "Combo"
Range("A1:B1").Font.Bold = True

On Error Resume Next
Range("A2").Select

'initialize variable to desired values
z = 1
y = 1
dblRow = 2
iCol = 1

'add the first element
aryA(y, 1) = aryNum(z)
aryA(y, 2) = "'" & Format(aryExp(z), "#,##0.00")

'initialize arrays with combos
For z = 2 To iCount
y = y + 1
aryA(y, 1) = aryNum(z)
aryA(y, 2) = "'" & Format(aryExp(z), "#,##0.00")
For x = 1 To ((2 ^ (z - 1)) - 1)
y = y + 1
aryA(y, 1) = aryA(x, 1) + aryNum(z)
aryA(y, 2) = aryA(x, 2) & " + " & _
Format(aryExp(z), "#,##0.00")
Next x
Next z

'put array info into worksheet
For r = 1 To y
Cells(dblRow, iCol) = aryA(r, 1)
Cells(dblRow, iCol + 1) = aryA(r, 2)
dblRow = dblRow + 1
If dblRow = 65000 Then
dblRow = 2
iCol = iCol + 4
End If
Next r

'format worksheet
Cells.Select
Range(Selection, _
ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Sort Key1:=Range("A2"), _
Order1:=xlAscending, HEADER:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
ActiveWindow.Zoom = 75

Range("A1:B1").Select

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With

Selection.Font.Underline = xlUnderlineStyleSingle
Columns("A:A").Select
Selection.NumberFormat = _
"_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
Columns("A:B").Select
Columns("A:B").EntireColumn.AutoFit
Columns("B:B").Select
If Selection.ColumnWidth 75 Then
Selection.ColumnWidth = 75
End If
Selection.HorizontalAlignment = xlLeft

Rows("1:1").Select
Selection.Insert Shift:=xlDown
dblLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
dblLastRow = dblLastRow + 1

'adjust info for max # of processed cells
If iCount 15 Then iCount = 15

Application.ActiveCell.Formula = "=Text(SUBTOTAL(3,A3:A" & _
dblLastRow + 10 & ")," & Chr(34) & _
"#,##0" & Chr(34) & ") & " & _
Chr(34) & " Combinations found for " & _
Application.WorksheetFunction.Text(iCount, "#,##") & _
" selections in range: " & _
strRngInputAddress & Chr(34)
Selection.Font.Bold = True

're-hide previously hidden sheets
y = UBound(aryHiddensheets)
For x = 1 To y
Worksheets(aryHiddensheets(x)).Visible = False
Next

Cells.Select
With Selection.Font
.Name = "Tahoma"
.Size = 10
End With

Range("A3").Select
ActiveWindow.FreezePanes = True

Application.Dialogs(xlDialogWorkbookName).Show

exit_Sub:
Set rngInput = Nothing
Exit Sub
End Sub
'/=================================================/







"LAdekoya" wrote:

I have four data elements and each can have one of three possible data values
at any one point in time. How can I auto-generate in excel, the various
possible data value combinations/mixes that I can get for these four items?
Assume the data elements are 1, 2, 3 & 4 and that the possible values are a,
b & c. Any help would be greatly appreciated.

Need to derive combinations for 4 elements each with 3 possibl
 

Hi Gary

Thanks for this but it doesn't really give me what I am after. I think it is
my fault. Perhaps I did not word my question well enough. My problem is this:
I have four fields on a dialog. Each of these fields cant take any of three
values - Tx, Non-Tx, Unspecified. The different combinations of these values
in these fields should cause the dialog to behave in different ways and I am
looking to specify this behaviour. To do this, I need to list all the
different combinations. Your macro lists single values in its results when I
am always looking for four.

Thanks

"Gary L Brown" wrote:

1) List out the 12 combinations for
1a,1b,1c,2a,2b,2c,3a,3b,3c,4a,4b,4c
This will derive 4,096 combinations (2^12)

The macro listed below will create a worksheet with all 4,096 combinations.
I use it for check reconciliations at works. I currently have it set up for
15 selections or less because 2^15 = 32,768 and I didn't want to deal with
wrapping into more columns.

HTH,
Gary Brown

If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".

'/=================================================/
Sub Combos()
'This program will give the addition of each combination
' of cells selected
'The # of combinations is calculated as
' [2^(# of cells selected)] - 1
'
On Error Resume Next
Dim aryHiddensheets()
Dim aryNum() As Double, aryExp() As String
Dim aryA()
Dim dblLastRow As Double, dblRow As Double
Dim i As Double
Dim x As Integer, iMaxCount As Integer
Dim z As Integer, r As Integer
Dim y As Integer, iWorksheets As Integer
Dim iCol As Integer
Dim iCount As Integer
Dim objCell As Object
Dim rngInput As Range
Dim strOriginalAddress As String
Dim strRngInputAddress As String
Dim strWorksheetName As String
Dim strResultsTableName As String
Dim varAnswer As Variant

'/----------start-up Variables-------------/
strResultsTableName = "Combinations_Listing"
strOriginalAddress = Selection.Address
strWorksheetName = ActiveSheet.Name
iMaxCount = 15
'/----------end start-up Variables---------/

Set rngInput = _
Application.InputBox(Prompt:= _
"Select Range of Numbers to be used as input for " & _
"combinations output" & vbCr & vbCr & _
"Note: Currently limited to " & _
iMaxCount & " cells or less", _
Title:="Combinations....", _
Default:=strOriginalAddress, Type:=8)

'get how many cells have been selected and location
iCount = rngInput.Count
strRngInputAddress = rngInput.Address

Select Case iCount
Case 0
MsgBox "No cells have been selected." & vbCr & _
vbCr & "Process aborted...", _
vbExclamation + vbOKOnly, _
"Warning..."
GoTo exit_Sub
Case 1 To iMaxCount
i = (2 ^ iCount) - 1
varAnswer = MsgBox("The " & iCount & _
" selected cell(s) will produce " & _
Application.WorksheetFunction.Text(i, "#,##") & _
" combinations." & vbCr & "Do you wish to continue?", _
vbInformation + vbYesNo, _
"Combinations...")
If varAnswer = vbNo Then Exit Sub
Case Is iMaxCount
varAnswer = _
MsgBox("Only the first " & iMaxCount & _
" cells in the range <<< " & _
strRngInputAddress & " will be processed." & vbCr & _
vbCr & "Continue?", vbExclamation + vbYesNo, "Warning")
If varAnswer = vbNo Then Exit Sub
End Select

If iCount iMaxCount Then iCount = iMaxCount

'now that we can calculate the actual dimensions
' we can re-dimension the arrays
ReDim aryNum(1 To iCount)
ReDim aryA(1 To ((2 ^ iCount) - 1), 1 To 2)
ReDim aryExp(1 To iCount)

'populate the array with the values in the selected cells
i = 0
For Each objCell In rngInput
i = i + 1
If i iMaxCount Then Exit For
aryNum(i) = objCell.Value
aryExp(i) = _
Application.WorksheetFunction.Text(objCell.Value, "@")
Next objCell

'Count number of worksheets in workbook
iWorksheets = ActiveWorkbook.Sheets.Count

'redim array
ReDim aryHiddensheets(1 To iWorksheets)

'put hidden sheets in an array, then unhide the sheets
For x = 1 To iWorksheets
If Worksheets(x).Visible = False Then
aryHiddensheets(x) = Worksheets(x).Name
Worksheets(x).Visible = True
End If
Next

'Check for duplicate Worksheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If UCase(Worksheets(x).Name) = _
UCase(strResultsTableName) Then
Worksheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Exit For
End If
Next

'Add new worksheet at end of workbook
' where results will be located
Worksheets.Add.Move After:=Worksheets(ActiveSheet.Name)

'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.Name = strResultsTableName
ActiveWorkbook.ActiveSheet.Range("A1").Value = "Amount"
ActiveWorkbook.ActiveSheet.Range("B1").Value = "Combo"
Range("A1:B1").Font.Bold = True

On Error Resume Next
Range("A2").Select

'initialize variable to desired values
z = 1
y = 1
dblRow = 2
iCol = 1

'add the first element
aryA(y, 1) = aryNum(z)
aryA(y, 2) = "'" & Format(aryExp(z), "#,##0.00")

'initialize arrays with combos
For z = 2 To iCount
y = y + 1
aryA(y, 1) = aryNum(z)
aryA(y, 2) = "'" & Format(aryExp(z), "#,##0.00")
For x = 1 To ((2 ^ (z - 1)) - 1)
y = y + 1
aryA(y, 1) = aryA(x, 1) + aryNum(z)
aryA(y, 2) = aryA(x, 2) & " + " & _
Format(aryExp(z), "#,##0.00")
Next x
Next z

'put array info into worksheet
For r = 1 To y
Cells(dblRow, iCol) = aryA(r, 1)
Cells(dblRow, iCol + 1) = aryA(r, 2)
dblRow = dblRow + 1
If dblRow = 65000 Then
dblRow = 2
iCol = iCol + 4
End If
Next r

'format worksheet
Cells.Select
Range(Selection, _
ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Sort Key1:=Range("A2"), _
Order1:=xlAscending, HEADER:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
ActiveWindow.Zoom = 75

Range("A1:B1").Select

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With

Selection.Font.Underline = xlUnderlineStyleSingle
Columns("A:A").Select
Selection.NumberFormat = _
"_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
Columns("A:B").Select
Columns("A:B").EntireColumn.AutoFit
Columns("B:B").Select
If Selection.ColumnWidth 75 Then
Selection.ColumnWidth = 75
End If
Selection.HorizontalAlignment = xlLeft

Rows("1:1").Select
Selection.Insert Shift:=xlDown
dblLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
dblLastRow = dblLastRow + 1

'adjust info for max # of processed cells
If iCount 15 Then iCount = 15

Application.ActiveCell.Formula = "=Text(SUBTOTAL(3,A3:A" & _
dblLastRow + 10 & ")," & Chr(34) & _
"#,##0" & Chr(34) & ") & " & _
Chr(34) & " Combinations found for " & _
Application.WorksheetFunction.Text(iCount, "#,##") & _
" selections in range: " & _
strRngInputAddress & Chr(34)
Selection.Font.Bold = True

're-hide previously hidden sheets
y = UBound(aryHiddensheets)
For x = 1 To y
Worksheets(aryHiddensheets(x)).Visible = False
Next

Cells.Select
With Selection.Font
.Name = "Tahoma"
.Size = 10
End With

Range("A3").Select
ActiveWindow.FreezePanes = True

Application.Dialogs(xlDialogWorkbookName).Show

exit_Sub:
Set rngInput = Nothing
Exit Sub
End Sub
'/=================================================/







"LAdekoya" wrote:

I have four data elements and each can have one of three possible data values
at any one point in time. How can I auto-generate in excel, the various
possible data value combinations/mixes that I can get for these four items?
Assume the data elements are 1, 2, 3 & 4 and that the possible values are a,
b & c. Any help would be greatly appreciated.

Need to derive combinations for 4 elements each with 3 possibl
 

If you will forgive a slight deviation from the way you specified the
problem in your first request, the following procedure will generate
all combinations of the 3 values, 0,1 and 2, in four positions:

In A1, B1, C1 and D1 enter the value 2

In A2, B2, C2 and D2 enter the value 0 (zero)

In A3: =IF(AND(B3=0,C3=0,D3=0),IF(A2<A$1,A2+1,0),A2)
In B3: =IF(AND(C3=0,D3=0),IF(B2<B$1,B2+1,0),B2)
In C3: =IF(D3=0,IF(C2<C$1,C2+1,0),C2)
In D3: =IF(D2=$D$1,0,D2+1)

Now drag/copy down as far as row 82. This will give you the 81
(3*3*3*3) different combinations of 0, 1, and 2 in 4 positions. You
can now use these values (+1 of course) as indexes into a range
containing your 3 permitted values for each position.

The reason for row 1 in my solution is to generalize the solution. Row
1 contains the maximum values that can occur in each position; these
values may differ one from the other. In your case they are are all 2,
representing the values 0, 1, and 2. If you had larger values you
would simply have dragged the formulas down further.

This could easily be modified to show combinations of 1, 2, and 3, but
I already had this from a prior question and chose not to change it. I
hope you don't mind.

HTH

Need to derive combinations for 4 elements each with 3 possibl
 

DOR,

This works brilliantly. Many thanks.

LAdekoya

"DOR" wrote:

If you will forgive a slight deviation from the way you specified the
problem in your first request, the following procedure will generate
all combinations of the 3 values, 0,1 and 2, in four positions:

In A1, B1, C1 and D1 enter the value 2

In A2, B2, C2 and D2 enter the value 0 (zero)

In A3: =IF(AND(B3=0,C3=0,D3=0),IF(A2<A$1,A2+1,0),A2)
In B3: =IF(AND(C3=0,D3=0),IF(B2<B$1,B2+1,0),B2)
In C3: =IF(D3=0,IF(C2<C$1,C2+1,0),C2)
In D3: =IF(D2=$D$1,0,D2+1)

Now drag/copy down as far as row 82. This will give you the 81
(3*3*3*3) different combinations of 0, 1, and 2 in 4 positions. You
can now use these values (+1 of course) as indexes into a range
containing your 3 permitted values for each position.

The reason for row 1 in my solution is to generalize the solution. Row
1 contains the maximum values that can occur in each position; these
values may differ one from the other. In your case they are are all 2,
representing the values 0, 1, and 2. If you had larger values you
would simply have dragged the formulas down further.

This could easily be modified to show combinations of 1, 2, and 3, but
I already had this from a prior question and chose not to change it. I
hope you don't mind.

HTH