List All Possible Excel Combinations From a Single Column

[khannadh]

Hello,

I have single column in Excel with 6 unique values and I want to list all possible unique combinations (combinations of 2, 3, 4, and 5).
Example:

Column A
John
Jones
Jamy
Sarah
Mark
Mike

The output I'm chasing is all possible combinations of 2, 3, 4, and 5.
Example: (John, Jones), (John, Jamy)..... (John, Jones, Jamy), (John, Jones, Sarah)....... (John, Jones, Jamy, Sarah), (John, Jones, Jamy, Mark)..... (John, Jones, Jamy, Sarah, Mark)......

Searched the internet for a while now and dont seem to find anything.
Would really appreciate someone's help.

Thank You

 

[ParamRay]

Here's a quick and dirty macro to do it:

Sub ListAllCombinations()
  Dim items(1 To 6) As String
  Dim x As Worksheet
  Dim txt As String
  Dim a As Integer, b As Integer, c As Integer
  Dim d As Integer, e As Integer, f As Integer
  Dim n As Integer
  
' List the names here:
  items(1) = "James"
  items(2) = "John"
  items(3) = "Robert"
  items(4) = "Michael"
  items(5) = "William"
  items(6) = "David"
  
  Set x = ThisWorkbook.Sheets.Add
  For a = True To False
    For b = True To False
      For c = True To False
        For d = True To False
          For e = True To False
            For f = True To False
              n = n + 1
              txt = "("
              If a Then txt = txt & items(1) & ", "
              If b Then txt = txt & items(2) & ", "
              If c Then txt = txt & items(3) & ", "
              If d Then txt = txt & items(4) & ", "
              If e Then txt = txt & items(5) & ", "
              If f Then txt = txt & items(6) & ", "
              txt = txt & ")"
              txt = Replace(txt, ", )", ")")
              x.Cells(n, 1).Value = n
              x.Cells(n, 2).Value = txt
            Next f
          Next e
        Next d
      Next c
    Next b
  Next a
  MsgBox n & " combinations found.", vbInformation
End Sub

 

[MickG]

Try this for results in column "B"

Sub MG11Aug16
Dim Ray As Variant, n As Long, nn As Long, Allnum As String, c As Long
Dim Res As Long, obit, oSt, ipc, Tot As Long, oPst As Long, sNum As String
Ray = Application.Transpose(Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)))
sNum = Join(Evaluate("TRANSPOSE(ROW(" & 1 & ":" & UBound(Ray) & "))"), ",")
For n = 1 To UBound(Ray)
    Tot = Tot + Application.Combin(UBound(Ray), n)
Next n
ReDim oVal(1 To Tot)
ReDim nRay(1 To Tot - UBound(Ray))
Do Until Allnum = sNum
   If c < UBound(Ray) Then
       For n = 1 To UBound(Ray)
             c = c + 1: oVal(c) = n
       Next n
   Else
       For n = 1 To UBound(Ray)
             Res = Res + 1
             obit = oVal(Res)
             oSt = Split(obit, ",")(UBound(Split(obit, ",")))
                For nn = oSt + 1 To UBound(Ray)
                    c = c + 1
                    Allnum = obit & "," & nn
                    oVal(c) = Allnum
                Next nn
         Next n
   End If
Loop
Dim S As Variant, nStr As String
    For oPst = UBound(Ray) + 1 To UBound(oVal)
        For Each S In Split(oVal(oPst), ",")
            nStr = nStr & IIf(nStr = "", Ray(S), "," & Ray(S))
        Next S
            nRay(oPst - UBound(Ray)) = nStr: nStr = ""
  Next oPst
Range("B1").Resize(UBound(nRay)).value = Application.Transpose(nRay)
End Sub

Regards Mick

 

[khannadh]

Brilliant, both codes work like a charm. Thank you so much, I appreciate it.

 

[MickG]

You're welcome