combinations

[bstar14]

I am trying to find a solution to this problem. I want to be able to return all of the possible combinations of numbers.

A B C D
1 1 1 1
2 2 2 2
3 3 3 3

A + B + C + D

return the values of A1B1C1D1,1112,1113,1121,1122,1123, through to 3333

 

[L. Howard]

Give this a try. It is some code that has been around quite awhile.

With your data on sheet1, A1 to D4, run Public Sub Perm_ABCD_I() to list your permutations in column I, I2 and down.

Howard

In a standard module copy:

Option Explicit
Option Base 0

Private Sub PermuteColumns(sourceColumns As Range, targetColumn As Range, separator As String)
Dim r As Long
Dim c As Long
ReDim counters(sourceColumns.Columns.Count - 1) As Long
ReDim lastRows(sourceColumns.Columns.Count - 1) As Long
Dim targetString As String
' Source data must be a single row
If sourceColumns.Rows.Count <> 1 Then Exit Sub
' Columns must be contiguous
If sourceColumns.Count > 1 Then
    r = 0
    For c = 2 To sourceColumns.Count
        If sourceColumns(c).Column - sourceColumns(c - 1).Column <> 1 Then
            r = 1
            Exit For
        End If
    Next c
    If r = 1 Then Exit Sub
End If
' Target must be a single cell
If targetColumn.Count <> 1 Then Exit Sub
' Set up counters and find the last row for each column
For c = 0 To sourceColumns.Columns.Count - 1
    With Sheets(sourceColumns.Parent.Name)
        counters(c) = 0
        lastRows(c) = .Cells(.Rows.Count, sourceColumns.Column + c).End(xlUp).Row - sourceColumns.Row
    End With
Next c
' Now fill in the permutations
r = 0
Do
    ' The permutation string
    targetString = ""
    
    ' Look through each column
    For c = 0 To sourceColumns.Columns.Count - 1
        If separator = vbTab Then
            targetColumn.Offset(r, c).Value = sourceColumns(c + 1).Offset(counters(c), 0).Value
        Else
            targetString = targetString & IIf(targetString = "", "", separator) & sourceColumns(c + 1).Offset(counters(c), 0).Value
        End If
    Next c
    
    ' Transfer the target string if necessary
    If separator <> vbTab Then targetColumn.Offset(r, 0).Value = targetString
    
    ' Move to the next row
    r = r + 1
    
    ' Now increment the counters
    c = sourceColumns.Columns.Count - 1
    Do
        counters(c) = counters(c) + 1
        If counters(c) > lastRows(c) Then
            counters(c) = 0
            c = c - 1
        Else
            Exit Do
        End If
    Loop Until c < 0
   
Loop Until c < 0
End Sub


Public Sub Perm_ABCD_I()
PermuteColumns [a1:d1], [I2], " "
End Sub

 

[Kaper]

Write in B2:

=MOD(ROUNDDOWN((ROW()-2)/3^(COLUMN()-2),0),3)+1

copy it right and down to B2:E88
now you can copy whole range, paste as values and reorder columns - because numbers are generated with this formula as
1111
2111
3111
1211
etc

if you would like numbers to 6 just change both 3 to 6 in formula
=MOD(ROUNDDOWN((ROW()-2)/6^(COLUMN()-2),0),6)+1
and of course you can copy it more to the right to have 5,6 etc digits.