# Listing each different combination configuration

#### Brew

##### Well-known Member
Is there a formula or code that will take each 3 digit combination in the range C6:E90 and place the 6 different ways each combination can be configured into columns G, H, I, starting with row 6.
Example:
If c6:e6=056
Then, G6:I11=056,065,506,560,605,650
And if c7:e7=231
Then, G12:I17=231,213,321,312,123,132
and so on

Each digit is different within the combination, there are no duplicates

### Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

#### Peter_SSs

##### MrExcel MVP, Moderator
Brew

I think a vba solution may the best here, but it is not my strong point so here is one possible formula solution:

1. I have added a 'helper' table in K1:L18
2. Formula in G6 (copied across and down):
=INDEX(\$C\$6:\$E\$8,1+INT((ROWS(G\$6:G6)-1)/6),VLOOKUP(3*MOD(ROWS(G\$6:G6)-1,6)+COLUMNS(\$G6:G6),\$K\$1:\$L\$18,2,0))

Colour has been added manually to aid checking of results.
Mr Excel.xls
CDEFGHIJKL
111
222
333
441
553
605605662
723106572
894650681
956093
10605102
11650113
12231121
13213133
14321141
15312152
16123163
17132172
18946181
Combinations

#### SydneyGeek

##### MrExcel MVP
Brew,

Here is some code to do the trick.
Note: It is hard-wired to do PERMUT(3,3) permutations.
Place in a code module, run by returning to Excel, pressing Alt + F8 and double-clicking the macro name.
Code:
``````Sub PermutArray()
Dim Token(1 To 3) As Variant
Dim vOut(1 To 3) As Variant
Dim vArray() As Variant
Dim x As Long, m As Long
Dim K As Long, i As Long
K = WorksheetFunction.Permut(3, 3)

x = Range("C:C").SpecialCells(xlCellTypeConstants).Count * K
ReDim vArray(1 To x, 1 To 3)
Dim Rw As Long
Dim c As Range
Rw = Range("C65536").End(xlUp).Row

m = 1
For Each c In Range("C6:C" & Rw)
Token(1) = c.Value
Token(2) = c.Offset(0, 1).Value
Token(3) = c.Offset(0, 2).Value
For i = 1 To K
vOut(1) = Token(3)
vOut(2) = Token(1)
vOut(3) = Token(2)

Token(1) = vOut(1)
Token(2) = vOut(2)
Token(3) = vOut(3)

vArray(m, 1) = Token(1)
vArray(m, 2) = Token(2)
vArray(m, 3) = Token(3)
m = m + 1
Next i
Next c
Range("G6").Resize(x, 3) = vArray
End Sub``````
Denis

#### Brew

##### Well-known Member
I have not test the formula version, though I agree that code may be the best approach.
The code solution:
When I used the test data in
c6:e6=056
I should have gotten G6:I11=056,065,506,560,605,650
but I got 605,560,056,605,560,056 (605,560, and 056 repeated)

I should have following: for each row: cde, ced, dce, dec, ecd, edc
Can the code be reformatted to get this result or is there another solution?

#### Brew

##### Well-known Member
I think Peter and Sydney have retired for the evening and our offline. Is there anyone else that has a code modification that would solve this problem?

#### SydneyGeek

##### MrExcel MVP
Hi Brew,

try this:
Code:
``````Sub PermutArray_v2()
Dim Token(1 To 3) As Variant
Dim vOut(1 To 3) As Variant
Dim vArray() As Variant
Dim x As Long, m As Long
Dim K As Long, i As Long
K = WorksheetFunction.Permut(3, 3)
x = Range("C:C").SpecialCells(xlCellTypeConstants).Count * K
ReDim vArray(1 To x, 1 To 3)
Dim Rw As Long
Dim c As Range
Rw = Range("C65536").End(xlUp).Row

m = 1
For Each c In Range("C6:C" & Rw)
Token(1) = c.Value
Token(2) = c.Offset(0, 1).Value
Token(3) = c.Offset(0, 2).Value

'this is ugly but does the job...
'1
vArray(m, 1) = Token(1)
vArray(m, 2) = Token(2)
vArray(m, 3) = Token(3)
m = m + 1
'2
Call FlipElements(Token, 1, 2)
vArray(m, 1) = Token(1)
vArray(m, 2) = Token(2)
vArray(m, 3) = Token(3)
m = m + 1
'3
Call FlipElements(Token, 2, 3)
vArray(m, 1) = Token(1)
vArray(m, 2) = Token(2)
vArray(m, 3) = Token(3)
m = m + 1
'4
Call FlipElements(Token, 1, 2)
vArray(m, 1) = Token(1)
vArray(m, 2) = Token(2)
vArray(m, 3) = Token(3)
m = m + 1
'5
Call FlipElements(Token, 2, 3)
vArray(m, 1) = Token(1)
vArray(m, 2) = Token(2)
vArray(m, 3) = Token(3)
m = m + 1
'6
Call FlipElements(Token, 1, 2)
vArray(m, 1) = Token(1)
vArray(m, 2) = Token(2)
vArray(m, 3) = Token(3)
m = m + 1
Next c
Range("G6").Resize(x, 3) = vArray
End Sub

Private Sub FlipElements(varArray As Variant, _
item1 As Integer, item2 As Integer)
Dim Temp As Variant
Dim i As Integer

Temp = varArray(item2)
varArray(item2) = varArray(item1)
varArray(item1) = Temp
End Sub``````
Denis

#### SydneyGeek

##### MrExcel MVP
Here's a more general solution.
Adjust RANGE_SIZE to suit the number of items to grab
Adjust your output column so that it doesn't step on the input
Works with text values as well
Do not exceed 65536 permutations

Code:
``````Dim Perm() As Variant

Sub PermutArray_v3()
Dim vArray() As Variant
Dim X As Long, m As Long
Dim K As Long, i As Long, j As Long, b As Long
Const RANGE_SIZE = 3 'numbers to permute
Dim Token(1 To RANGE_SIZE) As Variant
Dim vOut(1 To RANGE_SIZE) As Variant
K = WorksheetFunction.Permut(RANGE_SIZE, RANGE_SIZE)
X = Range("C:C").SpecialCells(xlCellTypeConstants).Count * K
Dim Rw As Long
Dim c As Range
Rw = Range("C65536").End(xlUp).Row
ReDim vArray(1 To X, 1 To RANGE_SIZE)

'create all positional permutations for PERMUT(N,N) where N = RANGE_SIZE
GenPermutations (RANGE_SIZE)

m = 1
For Each c In Range("C6:C" & Rw)
For b = 1 To RANGE_SIZE
Token(b) = c.Offset(0, b - 1).Value
Next b

'using GenPermutations to get all options...
For j = 1 To K
For i = 1 To RANGE_SIZE
vArray(m, i) = Token(Perm(j, i))
Next i
m = m + 1
Next j
Next c
Range("G6").Resize(X, RANGE_SIZE) = vArray
End Sub

Sub GenPermutations(ByVal N As Long)
'
' "Johnson-Trotter" VB6 implementation by MathImagics (Dec 2004)
'   Each permutation is obtained from the previous by
'   swapping just ONE pair of adjacent items.
'   Adapted 6 Sep 2006 by SydneyGeek
'   to write permutations out to an array.

Dim Item()   As Long   ' items to permute
Dim Link()   As Long   ' 0 = link left, 1 = right
Dim j        As Long
Dim K As Long, kSpot As Long  ' largest mobile K and its position
Dim P As Long, pSpot As Long  ' iterator value P, its position
Dim mobile   As Boolean         ' "mobility" test flag
Dim kLink    As Long
Dim X As Long, Z As Long
Z = WorksheetFunction.Permut(N, N)
'
' 0. Setup initial state
'
ReDim Perm(1 To Z, 1 To N)
For j = 1 To N
Item(j) = j
Next
Z = 1
Do
'
' 1. report current permutation
'
For j = 1 To N
Perm(Z, j) = Item(j)
Next j
Z = Z + 1
'
' 2. select "mobile" position with highest value
'
K = 0
pSpot = 0

Do While pSpot < N
pSpot = pSpot + 1
P = Item(pSpot)

mobile = False

If Link(pSpot) = 0 Then
If pSpot > 1 Then
If Item(pSpot - 1) < P Then mobile = True
End If
ElseIf pSpot < N Then
If Item(pSpot + 1) < P Then mobile = True
End If

If mobile Then
If P > K Then
K = P
kSpot = pSpot
If K = N Then Exit Do ' look no further
End If
End If
Loop

If K = 0 Then Exit Do  ' all done!

'
' 3.  Swap item kSpot with "neighbour"
'
Item(kSpot) = Item(kSpot + 1): Link(kSpot) = Link(kSpot + 1)
Item(kSpot + 1) = K:           Link(kSpot + 1) = 1
Else
Item(kSpot) = Item(kSpot - 1): Link(kSpot) = Link(kSpot - 1)
Item(kSpot - 1) = K:           Link(kSpot - 1) = 0
End If
'
' 4. Toggle Links for any items > K
'
For pSpot = 1 To N
If Item(pSpot) > K Then Link(pSpot) = 1 - Link(pSpot)
Next
Loop
End Sub``````
Denis

#### jindon

##### MrExcel MVP
Hi
try
Code:
``````Sub test()
Dim a, result(), n As Long, t As Long
Dim i As Long, ii As Integer, iii As Integer, iv As Integer
a=Range("c6",Range("c" & Rows.Count).End(xlUp)).Resize(,3).Value
For i = 1 To UBound(a,1)
ReDim result(1 To 6,1 To 1) : n = 0
For ii = 1 To 3
For iii = 1 To 3
For iv = 1 To 3
If (ii <> iii) * (iii <> iv) * (ii <> iv) Then
n = n + 1
result(n,1) = a(i,ii) & a(i, iii) & a(i,iv)
End If
Next
Next
Next
Range("g" & 6 + t).Resize(6) = result
t = t + 6
Next
End Sub``````

#### agihcam

##### Well-known Member
Code:
``````Sub sample()
Dim i As Long
Application.ScreenUpdating = False
Range("g5:i" & Rows.Count).ClearContents
Range("g5").Resize(, 3).Value = Array("h1", "h2", "h3")
For i = 6 To Range("c" & Rows.Count).End(xlUp).Row
Range("g" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Cells(i, "c"), Cells(i, "d"), Cells(i, "e"))
Range("g" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Cells(i, "c"), Cells(i, "e"), Cells(i, "d"))
Range("g" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Cells(i, "d"), Cells(i, "c"), Cells(i, "e"))
Range("g" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Cells(i, "d"), Cells(i, "e"), Cells(i, "c"))
Range("g" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Cells(i, "e"), Cells(i, "c"), Cells(i, "d"))
Range("g" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Cells(i, "e"), Cells(i, "d"), Cells(i, "c"))
Next
Range("g5").Resize(, 3).ClearContents
Application.ScreenUpdating = True
End Sub``````

#### Brew

##### Well-known Member
Thanks gentleman for your solutions, I've chosen agihcam's solution as the best approach

Replies
0
Views
149
Replies
5
Views
129
Replies
1
Views
59
Replies
10
Views
387
Replies
0
Views
299

### Forum statistics

1,176,228
Messages
5,902,042
Members
434,937
Latest member
Callum_97 ### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

### Which adblocker are you using?    Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option. Go back

### Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com". Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back