Generating unique combination

[BigBeachBananas]

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!

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

 

[BigBeachBananas]

[BUMP]

 

[johnnyL]

The code you posted errors to run time 1004.

 

[Phuoc]

Try this:

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

 

[johnnyL]

Disregard Post #3, I got it now.

 

[johnnyL]

Why over complicate it?

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

 

[BigBeachBananas]

Why over complicate it?

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.

 

[BigBeachBananas]

Try this:

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

 

[johnnyL]

How about:

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

 

[BigBeachBananas]

How about:

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!