To find all possible combinations of strings present in a column range (order does not matter ,repetition not allowed)

Question

I want to get all possible combinations of certain values present in a column range and print them in an excel sheet:

Please note that the order of combination does not matter i.e AB=BA

Here is an example of data in column1 for which combinations are to be found:

F1
F2
F3
F4

The possible combinations of these are :

F1F2
F1F3
F1F4
F2F3
F2F4
F3F4
F1F2F3
F1F2F4
F1F3F4
F2F3F4
F1F2F3F4

Answer 1

This is my first Stack Overflow answer:

This might not be the most elegant approach, but it works. First eliminate any repetitions in the data. My inclination is to use a VBScript dictionary for that -- but you can do it in pure VBA like this. If you have n distinct items -- count from 0 to 2^n -1 in base 2, each of which corresponds to a combination (subset). You seem to want to throw out subsets of size less than 2. I wrote a function which does this, as well as a sub to test it with. The sub assumes that the data starts in A1 and is contiguous. It prints the results in column B:

Sub AddItem(C As Collection, x As Variant)
    Dim i As Long
    For i = 1 To C.Count
        If C(i) = x Then Exit Sub
    Next i
    C.Add (x)
End Sub

Function Base2(number As Long, width As Long) As String
    'assumes that width is long enough to hold number
    Dim n As Long, i As Long, r As Long, s As String
    Dim bits As Variant
    ReDim bits(1 To width)
    n = number
    i = width
    Do While n > 0
        r = n Mod 2
        n = Int(n / 2)
        If r > 0 Then bits(i) = 1
        i = i - 1
    Loop
    For i = 1 To width
        s = s & IIf(bits(i) > 0, "1", "0")
    Next i
    Base2 = s
End Function

'in what follows items is a variant array of strings
'it returns a variant array of strings consiting
'of combinations (of size > 1) of strings
Function Combos(items As Variant) As Variant
    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim b As String, s As String
    Dim oneCount As Long
    Dim itemSet As New Collection
    Dim retArray As Variant
    For i = LBound(items) To UBound(items)
        AddItem itemSet, items(i)
    Next i
    n = itemSet.Count
    ReDim retArray(1 To 2 ^ n - n - 1)
    i = 0
    For j = 3 To 2 ^ n - 1
        b = Base2(j, n)
        oneCount = 0
        s = ""
        For k = 1 To n
            If Mid(b, k, 1) = "1" Then
                s = s & itemSet(k)
                oneCount = oneCount + 1
            End If
        Next k
        If oneCount > 1 Then
            i = i + 1
            retArray(i) = s
        End If
    Next j
    Combos = retArray
End Function

Sub test()
    Dim r As Range, v As Variant, i As Long, n As Long
    Set r = Range("A1", Range("A1").End(xlDown))
    n = r.Cells.Count
    ReDim v(1 To n)
    For i = 1 To n
        v(i) = r.Cells(i)
    Next i
    v = Combos(v)
    For i = 1 To UBound(v)
        Range("B:B").Cells(i).Value = v(i)
    Next i
End Sub