Calculate all possible combinations

peter3578

New Member
Joined
Mar 7, 2016
Messages
1
Hello

I have 4 columns with different data. I need all possible combinations, one per row. How can I do that?

 

michaelsmith559

Well-known Member
Joined
Oct 6, 2013
Messages
842
Try this (you will be asked to select input range, in my sheet I chose A1:E16, next you will be asked if your data has headers, yes, then you will select cell where you want results pasted, I chose I1, next you will be asked if you want headers in your results, I chose yes; you can choose no). Here is how I setup sheet1:

Sheet1 setup:
<b>Excel 2012</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB"><colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #DAE7F5;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="font-weight: bold;text-align: center;;">A</td><td style="font-weight: bold;text-align: center;;">B</td><td style="font-weight: bold;text-align: center;;">C</td><td style="font-weight: bold;text-align: center;;">D</td><td style="font-weight: bold;text-align: center;;">E</td><td style="font-weight: bold;text-align: right;;">Time</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d1</td><td style="text-align: center;;">e1</td><td style="font-weight: bold;text-align: right;;">Permutations</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: center;;">a2</td><td style="text-align: center;;">b2</td><td style="text-align: center;;">c2</td><td style="text-align: center;;">d2</td><td style="text-align: center;;">e2</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: center;;">a3</td><td style="text-align: center;;">b3</td><td style="text-align: center;;">c3</td><td style="text-align: center;;">d3</td><td style="text-align: center;;">e3</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="text-align: center;;"></td><td style="text-align: center;;">b4</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style="text-align: center;;"></td><td style="text-align: center;;">b5</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: center;;"></td><td style="text-align: center;;">b6</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style="text-align: center;;"></td><td style="text-align: center;;">b7</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style="text-align: center;;"></td><td style="text-align: center;;">b8</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">10</td><td style="text-align: center;;"></td><td style="text-align: center;;">b9</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">11</td><td style="text-align: center;;"></td><td style="text-align: center;;">b10</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">12</td><td style="text-align: center;;"></td><td style="text-align: center;;">b11</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">13</td><td style="text-align: center;;"></td><td style="text-align: center;;">b12</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">14</td><td style="text-align: center;;"></td><td style="text-align: center;;">b13</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style="text-align: center;;"></td><td style="text-align: center;;">b14</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style="text-align: center;;"></td><td style="text-align: center;;">b15</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5;color: #161120">Sheet1</p><br /><br />

After macro runs (I only pasted the first 16 rows):
<b>Excel 2012</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB"><colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #DAE7F5;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th><th>K</th><th>L</th><th>M</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="font-weight: bold;text-align: center;;">A</td><td style="font-weight: bold;text-align: center;;">B</td><td style="font-weight: bold;text-align: center;;">C</td><td style="font-weight: bold;text-align: center;;">D</td><td style="font-weight: bold;text-align: center;;">E</td><td style="font-weight: bold;text-align: right;;">Time</td><td style="text-align: center;;">0.015625</td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: center;;">A</td><td style="font-weight: bold;text-align: center;;">B</td><td style="font-weight: bold;text-align: center;;">C</td><td style="font-weight: bold;text-align: center;;">D</td><td style="font-weight: bold;text-align: center;;">E</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d1</td><td style="text-align: center;;">e1</td><td style="font-weight: bold;text-align: right;;">Permutations</td><td style="text-align: center;;">1215</td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d1</td><td style="text-align: center;;">e1</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: center;;">a2</td><td style="text-align: center;;">b2</td><td style="text-align: center;;">c2</td><td style="text-align: center;;">d2</td><td style="text-align: center;;">e2</td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d1</td><td style="text-align: center;;">e2</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: center;;">a3</td><td style="text-align: center;;">b3</td><td style="text-align: center;;">c3</td><td style="text-align: center;;">d3</td><td style="text-align: center;;">e3</td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d1</td><td style="text-align: center;;">e3</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="text-align: center;;"></td><td style="text-align: center;;">b4</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d2</td><td style="text-align: center;;">e1</td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style="text-align: center;;"></td><td style="text-align: center;;">b5</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d2</td><td style="text-align: center;;">e2</td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: center;;"></td><td style="text-align: center;;">b6</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d2</td><td style="text-align: center;;">e3</td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style="text-align: center;;"></td><td style="text-align: center;;">b7</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d3</td><td style="text-align: center;;">e1</td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style="text-align: center;;"></td><td style="text-align: center;;">b8</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d3</td><td style="text-align: center;;">e2</td></tr><tr ><td style="color: #161120;text-align: center;">10</td><td style="text-align: center;;"></td><td style="text-align: center;;">b9</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c1</td><td style="text-align: center;;">d3</td><td style="text-align: center;;">e3</td></tr><tr ><td style="color: #161120;text-align: center;">11</td><td style="text-align: center;;"></td><td style="text-align: center;;">b10</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c2</td><td style="text-align: center;;">d1</td><td style="text-align: center;;">e1</td></tr><tr ><td style="color: #161120;text-align: center;">12</td><td style="text-align: center;;"></td><td style="text-align: center;;">b11</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c2</td><td style="text-align: center;;">d1</td><td style="text-align: center;;">e2</td></tr><tr ><td style="color: #161120;text-align: center;">13</td><td style="text-align: center;;"></td><td style="text-align: center;;">b12</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c2</td><td style="text-align: center;;">d1</td><td style="text-align: center;;">e3</td></tr><tr ><td style="color: #161120;text-align: center;">14</td><td style="text-align: center;;"></td><td style="text-align: center;;">b13</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c2</td><td style="text-align: center;;">d2</td><td style="text-align: center;;">e1</td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style="text-align: center;;"></td><td style="text-align: center;;">b14</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c2</td><td style="text-align: center;;">d2</td><td style="text-align: center;;">e2</td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style="text-align: center;;"></td><td style="text-align: center;;">b15</td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;;"></td><td style="text-align: center;;">a1</td><td style="text-align: center;;">b1</td><td style="text-align: center;;">c2</td><td style="text-align: center;;">d2</td><td style="text-align: center;;">e3</td></tr></tbody></table><p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5;color: #161120">Sheet1</p><br /><br />

Macro:
Code:
Option Explicit 'Always a good idea to have this

'======================================================================
'MixMatchColumns
'======================================================================
'Macro that accepts a Data Range. Treats each of the columns as a
'set and generates a list of all permutations of the elements in
'each of the lists.
'Arguments:
'DataRange          - Range that contains the elements in each list
'ResultRange        - Cell where the results will be pasted
'DataHasHeaders     - Boolean variable that is used to specify if the
'                     data range included the column headers.
'                     Comes in handy if the CurrentRegion property
'                     is used to select the datarange
'HeadersInResult    - Boolean variable to decide if the uset wants
'                      to paste the headers also along with the results
'======================================================================
'Author     :   Ejaz Ahmed
'Date       :   21 February 2014
'Website    :   http://strugglingtoexcel.wordpress.com/
'Email      :   StrugglingToExcel@outlook.com
'======================================================================
Sub MixMatchColumns(ByRef DataRange As Range, _
                    ByRef ResultRange As Range, _
                    Optional ByVal DataHasHeaders As Boolean = False, _
                    Optional ByVal HeadersInResult As Boolean = False)

Dim rngData As Range
Dim rngResults As Range
Dim lngCount As Long
Dim lngCol As Long
Dim lngNumberRows As Long
Dim ItemCount() As Long
Dim RepeatCount() As Long
Dim PatternCount() As Long
'Long Variables for the Variour For Loops
Dim lngForRow As Long
Dim lngForPattern As Long
Dim lngForItem As Long
Dim lngForRept As Long
'Temporary Arrays used to store the Data and Results
Dim DataArray() As Variant
Dim ResultArray() As Variant

'If the Data range has headers, adjust the
'Range to contain only data
Set rngData = DataRange
If DataHasHeaders Then
    Set rngData = rngData.Offset(1).Resize(rngData.Rows.Count - 1)
End If

'Initialize the Data Array
DataArray = rngData.Value
'Get the number of Columns
lngCol = rngData.Columns.Count

'Initialize the Arrays
ReDim ItemCount(1 To lngCol)
ReDim RepeatCount(1 To lngCol)
ReDim PatternCount(1 To lngCol)

'Get the number of items in each column
For lngCount = 1 To lngCol
    ItemCount(lngCount) = _
        Application.WorksheetFunction.CountA(rngData.Columns(lngCount))
    If ItemCount(lngCount) = 0 Then
        MsgBox "Column " & lngCount & " does not have any items in it."
        Exit Sub
    End If
Next

'Calculate the number of Permutations
lngNumberRows = Application.Product(ItemCount)
Range("G2").Value = lngNumberRows
'Initialize the Results array
ReDim ResultArray(1 To lngNumberRows, 1 To lngCol)

'Get the number of times each of the items repeate
RepeatCount(lngCol) = 1
For lngCount = (lngCol - 1) To 1 Step -1
    RepeatCount(lngCount) = ItemCount(lngCount + 1) * _
                                RepeatCount(lngCount + 1)
Next lngCount

'Get howmany times the pattern repeates
For lngCount = 1 To lngCol
    PatternCount(lngCount) = lngNumberRows / _
            (ItemCount(lngCount) * RepeatCount(lngCount))
Next

'The Loop begins here, Goes through each column
For lngCount = 1 To lngCol
'Reset the row number for each column iteration
lngForRow = 1
    'Start the Pattern
    For lngForPattern = 1 To PatternCount(lngCount)
        'Loop through each item
        For lngForItem = 1 To ItemCount(lngCount)
            'Repeate the item
            For lngForRept = 1 To RepeatCount(lngCount)
                'Store the value in the array
                ResultArray(lngForRow, lngCount) = _
                        DataArray(lngForItem, lngCount)
                'Increment the Row number
                lngForRow = lngForRow + 1
            Next lngForRept
        Next lngForItem
    Next lngForPattern
Next lngCount

'Output the results
Set rngResults = ResultRange(1, 1).Resize(lngNumberRows, lngCol)
'If the user wants headers in the results
If DataHasHeaders And HeadersInResult Then
    rngResults.Rows(1).Value = DataRange.Rows(1).Value
    Set rngResults = rngResults.Offset(1)
End If
rngResults.Value = ResultArray()

End Sub
                        

Sub CoverMacro()

Dim rngData As Range
Dim rngResults As Range
Dim booDataHeader As Boolean
Dim booResultHeader As Boolean
Dim lngAns As Long
Dim strMessage As String
Dim strTitle As String
Dim StartTime As Double
Dim SecondsElapsed As Double


strTitle = "Get Permutations"

strMessage = "Select the Range that has the Lists:" _
    & vbNewLine & "Make sure there are no blank cells in between."

On Error Resume Next
Set rngData = Application.InputBox(strMessage, strTitle, , , , , , 8)
If Not Err.Number = 0 Then
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If
    

strMessage = "Does the Data have headers in it?"
lngAns = MsgBox(strMessage, vbYesNo, strTitle)
If Not Err.Number = 0 Then
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If

If lngAns = vbYes Then
    booDataHeader = True
Else
    booDataHeader = False
End If

strMessage = "Select the cell where you'd like the results to be pasted"
Set rngResults = Application.InputBox(strMessage, strTitle, , , , , , 8)
If Not Err.Number = 0 Then
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If

If booDataHeader Then
    strMessage = "Do you want headers in your Result?"
    lngAns = MsgBox(strMessage, vbYesNo, strTitle)
    
    If Not Err.Number = 0 Then
        Err.Clear
        On Error GoTo 0
        Exit Sub
    End If

    If lngAns = vbYes Then
        booResultHeader = True
    Else
        booResultHeader = False
    End If
Else
    booResultHeader = False
End If

StartTime = Timer

Call MixMatchColumns(rngData, rngResults, booDataHeader, booResultHeader)

SecondsElapsed = Timer - StartTime
Range("G1").Value = SecondsElapsed
End Sub
 

Sethnick

New Member
Joined
Aug 6, 2019
Messages
8
Try this (you will be asked to select input range, in my sheet I chose A1:E16, next you will be asked if your data has headers, yes, then you will select cell where you want results pasted, I chose I1, next you will be asked if you want headers in your results, I chose yes; you can choose no). Here is how I setup sheet1:

Sheet1 setup:
Excel 2012
ABCDEF
1ABCDETime
2a1b1c1d1e1Permutations
3a2b2c2d2e2
4a3b3c3d3e3
5b4
6b5
7b6
8b7
9b8
10b9
11b10
12b11
13b12
14b13
15b14
16b15

<tbody>
</tbody>
Sheet1



After macro runs (I only pasted the first 16 rows):
Excel 2012
ABCDEFGHIJKLM
1ABCDETime0.015625ABCDE
2a1b1c1d1e1Permutations1215a1b1c1d1e1
3a2b2c2d2e2a1b1c1d1e2
4a3b3c3d3e3a1b1c1d1e3
5b4a1b1c1d2e1
6b5a1b1c1d2e2
7b6a1b1c1d2e3
8b7a1b1c1d3e1
9b8a1b1c1d3e2
10b9a1b1c1d3e3
11b10a1b1c2d1e1
12b11a1b1c2d1e2
13b12a1b1c2d1e3
14b13a1b1c2d2e1
15b14a1b1c2d2e2
16b15a1b1c2d2e3

<tbody>
</tbody>
Sheet1



Macro:
Code:
Option Explicit 'Always a good idea to have this

'======================================================================
'MixMatchColumns
'======================================================================
'Macro that accepts a Data Range. Treats each of the columns as a
'set and generates a list of all permutations of the elements in
'each of the lists.
'Arguments:
'DataRange          - Range that contains the elements in each list
'ResultRange        - Cell where the results will be pasted
'DataHasHeaders     - Boolean variable that is used to specify if the
'                     data range included the column headers.
'                     Comes in handy if the CurrentRegion property
'                     is used to select the datarange
'HeadersInResult    - Boolean variable to decide if the uset wants
'                      to paste the headers also along with the results
'======================================================================
'Author     :   Ejaz Ahmed
'Date       :   21 February 2014
'Website    :   http://strugglingtoexcel.wordpress.com/
'Email      :   StrugglingToExcel@outlook.com
'======================================================================
Sub MixMatchColumns(ByRef DataRange As Range, _
                    ByRef ResultRange As Range, _
                    Optional ByVal DataHasHeaders As Boolean = False, _
                    Optional ByVal HeadersInResult As Boolean = False)

Dim rngData As Range
Dim rngResults As Range
Dim lngCount As Long
Dim lngCol As Long
Dim lngNumberRows As Long
Dim ItemCount() As Long
Dim RepeatCount() As Long
Dim PatternCount() As Long
'Long Variables for the Variour For Loops
Dim lngForRow As Long
Dim lngForPattern As Long
Dim lngForItem As Long
Dim lngForRept As Long
'Temporary Arrays used to store the Data and Results
Dim DataArray() As Variant
Dim ResultArray() As Variant

'If the Data range has headers, adjust the
'Range to contain only data
Set rngData = DataRange
If DataHasHeaders Then
    Set rngData = rngData.Offset(1).Resize(rngData.Rows.Count - 1)
End If

'Initialize the Data Array
DataArray = rngData.Value
'Get the number of Columns
lngCol = rngData.Columns.Count

'Initialize the Arrays
ReDim ItemCount(1 To lngCol)
ReDim RepeatCount(1 To lngCol)
ReDim PatternCount(1 To lngCol)

'Get the number of items in each column
For lngCount = 1 To lngCol
    ItemCount(lngCount) = _
        Application.WorksheetFunction.CountA(rngData.Columns(lngCount))
    If ItemCount(lngCount) = 0 Then
        MsgBox "Column " & lngCount & " does not have any items in it."
        Exit Sub
    End If
Next

'Calculate the number of Permutations
lngNumberRows = Application.Product(ItemCount)
Range("G2").Value = lngNumberRows
'Initialize the Results array
ReDim ResultArray(1 To lngNumberRows, 1 To lngCol)

'Get the number of times each of the items repeate
RepeatCount(lngCol) = 1
For lngCount = (lngCol - 1) To 1 Step -1
    RepeatCount(lngCount) = ItemCount(lngCount + 1) * _
                                RepeatCount(lngCount + 1)
Next lngCount

'Get howmany times the pattern repeates
For lngCount = 1 To lngCol
    PatternCount(lngCount) = lngNumberRows / _
            (ItemCount(lngCount) * RepeatCount(lngCount))
Next

'The Loop begins here, Goes through each column
For lngCount = 1 To lngCol
'Reset the row number for each column iteration
lngForRow = 1
    'Start the Pattern
    For lngForPattern = 1 To PatternCount(lngCount)
        'Loop through each item
        For lngForItem = 1 To ItemCount(lngCount)
            'Repeate the item
            For lngForRept = 1 To RepeatCount(lngCount)
                'Store the value in the array
                ResultArray(lngForRow, lngCount) = _
                        DataArray(lngForItem, lngCount)
                'Increment the Row number
                lngForRow = lngForRow + 1
            Next lngForRept
        Next lngForItem
    Next lngForPattern
Next lngCount

'Output the results
Set rngResults = ResultRange(1, 1).Resize(lngNumberRows, lngCol)
'If the user wants headers in the results
If DataHasHeaders And HeadersInResult Then
    rngResults.Rows(1).Value = DataRange.Rows(1).Value
    Set rngResults = rngResults.Offset(1)
End If
rngResults.Value = ResultArray()

End Sub
                        

Sub CoverMacro()

Dim rngData As Range
Dim rngResults As Range
Dim booDataHeader As Boolean
Dim booResultHeader As Boolean
Dim lngAns As Long
Dim strMessage As String
Dim strTitle As String
Dim StartTime As Double
Dim SecondsElapsed As Double


strTitle = "Get Permutations"

strMessage = "Select the Range that has the Lists:" _
    & vbNewLine & "Make sure there are no blank cells in between."

On Error Resume Next
Set rngData = Application.InputBox(strMessage, strTitle, , , , , , 8)
If Not Err.Number = 0 Then
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If
    

strMessage = "Does the Data have headers in it?"
lngAns = MsgBox(strMessage, vbYesNo, strTitle)
If Not Err.Number = 0 Then
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If

If lngAns = vbYes Then
    booDataHeader = True
Else
    booDataHeader = False
End If

strMessage = "Select the cell where you'd like the results to be pasted"
Set rngResults = Application.InputBox(strMessage, strTitle, , , , , , 8)
If Not Err.Number = 0 Then
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If

If booDataHeader Then
    strMessage = "Do you want headers in your Result?"
    lngAns = MsgBox(strMessage, vbYesNo, strTitle)
    
    If Not Err.Number = 0 Then
        Err.Clear
        On Error GoTo 0
        Exit Sub
    End If

    If lngAns = vbYes Then
        booResultHeader = True
    Else
        booResultHeader = False
    End If
Else
    booResultHeader = False
End If

StartTime = Timer

Call MixMatchColumns(rngData, rngResults, booDataHeader, booResultHeader)

SecondsElapsed = Timer - StartTime
Range("G1").Value = SecondsElapsed
End Sub
What if I wanted to do this, but "d1" existed in both columns D and E, and I didn't want any combinations to generate with two instances of "d1"? Or any instances of a duplicate for that matter? Can the code be edited to prohibit this from generating?
 

Forum statistics

Threads
1,078,461
Messages
5,340,442
Members
399,375
Latest member
alwayssunny

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top