# Generating unique combination

#### BigBeachBananas

##### Active Member
Hi,
I have the following VBA code from @Peter_SSs from another thread that generates unique combinations. However, the VBA omits combinations with repeated elements. For example, if I have elements A, B, and C then AA, BB, CC are omitted. I'm looking for some help modifying the VBA such that it retains the combinations with repeated elements. Thanks!

VBA Code:
``````Sub All2Combos()
Dim a As Variant, b As Variant
Dim i As Long, j As Long, x As Long, y As Long

a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a))
For i = 1 To UBound(a)
If Len(a(i, 1)) > 0 Then
x = x + 1: b(x) = a(i, 1)
End If
Next i
ReDim a(1 To WorksheetFunction.Combin(x, 2), 1 To 1)
For i = 1 To x - 1
For j = i + 1 To x
y = y + 1: a(y, 1) = b(i) & b(j)
Next j
Next i
Range("C2").Resize(y).Value = a
End Sub``````

### Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
[BUMP]

The code you posted errors to run time 1004.

Try this:
VBA Code:
``````Sub All2Combos()
'AA,BB,CC
Dim a As Variant, b As Variant
Dim i As Long, j As Long, x As Long, y As Long
a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a))
For i = 1 To UBound(a)
If Len(a(i, 1)) > 0 Then
x = x + 1: b(x) = a(i, 1)
End If
Next i
ReDim a(1 To x * x, 1 To 1)
For i = 1 To x
For j = 1 To x
y = y + 1
a(y, 1) = b(i) & b(j)
Next j
Next i
Range("C2").Resize(y).Value = a
End Sub``````

Disregard Post #3, I got it now.

Why over complicate it?

VBA Code:
``````Sub AllTwoComboTest()
'
Dim Array1Slot  As Long, Array2Slot As Long
Dim ComboList   As Object
Dim Array1      As Variant, Array2  As Variant
'
Set ComboList = CreateObject("System.Collections.ArrayList")                                ' Initialize CombList
'
Array1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)                              ' Load Colun A range into Array1
Array2 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)                              ' Load Colun A range into Array2
'
For Array1Slot = 1 To UBound(Array1)                                                        ' Initialize Array1 loop
For Array2Slot = 1 To UBound(Array2)                                                    '   Initialize Array2 loop
ComboList.Add Array2(Array2Slot, 1) & Array1(Array1Slot, 1)                         '       Save Combo into ComboList
Next                                                                                    '   Loop back
Next                                                                                        ' Loop back
'
Range("E2").Resize(ComboList.Count, 1).Value = Application.Transpose(ComboList.ToArray)     ' Display ComboList to column E
'
End Sub``````

Why over complicate it?

VBA Code:
``````Sub AllTwoComboTest()
'
Dim Array1Slot  As Long, Array2Slot As Long
Dim ComboList   As Object
Dim Array1      As Variant, Array2  As Variant
'
Set ComboList = CreateObject("System.Collections.ArrayList")                                ' Initialize CombList
'
Array1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)                              ' Load Colun A range into Array1
Array2 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)                              ' Load Colun A range into Array2
'
For Array1Slot = 1 To UBound(Array1)                                                        ' Initialize Array1 loop
For Array2Slot = 1 To UBound(Array2)                                                    '   Initialize Array2 loop
ComboList.Add Array2(Array2Slot, 1) & Array1(Array1Slot, 1)                         '       Save Combo into ComboList
Next                                                                                    '   Loop back
Next                                                                                        ' Loop back
'
Range("E2").Resize(ComboList.Count, 1).Value = Application.Transpose(ComboList.ToArray)     ' Display ComboList to column E
'
End Sub``````
Thanks for the solution, but your code outputs both combinations: AB and BA. I want only either AB or BA but not both.

Try this:
VBA Code:
``````Sub All2Combos()
'AA,BB,CC
Dim a As Variant, b As Variant
Dim i As Long, j As Long, x As Long, y As Long
a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a))
For i = 1 To UBound(a)
If Len(a(i, 1)) > 0 Then
x = x + 1: b(x) = a(i, 1)
End If
Next i
ReDim a(1 To x * x, 1 To 1)
For i = 1 To x
For j = 1 To x
y = y + 1
a(y, 1) = b(i) & b(j)
Next j
Next i
Range("C2").Resize(y).Value = a
End Sub``````
Thanks for the code but it's outputting permutations instead of combinations. For example, it's outputting AB and BA which are the same. I only want either AB or BA. Thanks

VBA Code:
``````Sub ModifiedAll2Combos()
Dim a As Variant, b As Variant
Dim i As Long, j As Long, x As Long, y As Long

a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a))
For i = 1 To UBound(a)
If Len(a(i, 1)) > 0 Then
x = x + 1
b(x) = a(i, 1)
End If
Next i
ReDim a(1 To WorksheetFunction.Combina(x, 2), 1 To 1)
For i = 1 To WorksheetFunction.Combina(x, 2) - 1
For j = i To x
y = y + 1
a(y, 1) = b(i) & b(j)
Next j
Next i
Range("C2").Resize(y).Value = a
End Sub``````

VBA Code:
``````Sub ModifiedAll2Combos()
Dim a As Variant, b As Variant
Dim i As Long, j As Long, x As Long, y As Long

a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a))
For i = 1 To UBound(a)
If Len(a(i, 1)) > 0 Then
x = x + 1
b(x) = a(i, 1)
End If
Next i
ReDim a(1 To WorksheetFunction.Combina(x, 2), 1 To 1)
For i = 1 To WorksheetFunction.Combina(x, 2) - 1
For j = i To x
y = y + 1
a(y, 1) = b(i) & b(j)
Next j
Next i
Range("C2").Resize(y).Value = a
End Sub``````
That works. Thanks!

Replies
1
Views
101
Replies
3
Views
237
Replies
5
Views
98
Replies
1
Views
71
Replies
7
Views
362

### Forum statistics

1,207,285
Messages
6,077,529
Members
446,288
Latest member
lihong3210 ### 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.

### Which adblocker are you using?    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

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