Excel vba Create combinations in same row each one - vba

Question

I need help with a macro that exports all combinations of a range in same row each one ( I mean horizontal exports).
Every combination I want to be in one cell each time.
I want to change any time the number of strings in the range and also the number of strings combinations (In the example below 4 strings in the range and 3 for combinations)
1. A B C D -------------ABC --ABD--ACD--BCD
2. E F G H--------------EFG---EFH--EGH--FGH
3. I G K L----------------IGK----IGL---IKL---GKL
Below its a module that I found in web that is very close to what I need.
I am very new to Vba macros and I cannot achieve what I am looking for with the below code
Private NextRow As Long
Sub Test()
Dim V() As Variant, SetSize As Integer, i As Integer
SetSize = Cells(2, Columns.count).End(xlToLeft).Column
ReDim V(1 To SetSize)
For i = 1 To SetSize
V(i) = Cells(2, i).Value
Next i
NextRow = 4
CreateCombinations V, 3, 3
End Sub
Sub CreateCombinations( _
OriginalSet() As Variant, _
MinSubset As Integer, MaxSubset As Integer)
Dim SubSet() As Variant, SubSetIndex As Long
Dim SubSetCount As Integer, Bit As Integer
Dim k As Integer, hBit As Integer
Dim MaxIndex As Long
hBit = UBound(OriginalSet) - 1
ReDim SubSet(1 To UBound(OriginalSet))
MaxIndex = 2 ^ UBound(OriginalSet) - 1
For SubSetIndex = 1 To MaxIndex
SubSetCount = BitCount(SubSetIndex)
If SubSetCount >= MinSubset And SubSetCount <= MaxSubset Then
k = 1
For Bit = 0 To hBit
If 2 ^ Bit And SubSetIndex Then
SubSet(k) = OriginalSet(Bit + 1)
k = k + 1
End If
Next Bit
DoSomethingWith SubSet, SubSetCount
End If
Next SubSetIndex
End Sub
Sub DoSomethingWith(SubSet() As Variant, ItemCount As Integer)
Dim i As Integer
For i = 1 To ItemCount
Cells(NextRow, i) = SubSet(i)
Next i
NextRow = NextRow + 1
End Sub
Function BitCount(ByVal Pattern As Long) As Integer
BitCount = 0
While Pattern
If Pattern And 1 Then BitCount = BitCount + 1
Pattern = Int(Pattern / 2)
Wend
End Function

Answer 1

Here is a way to do it:
In your excel sheet, add an array formula like this:
A B C D E
1
2 A B C D {=k_combinations(CONCATENATE(A2;B2;C2;D2);3)}
3 E F G H {=k_combinations(CONCATENATE(A3;B3;C3;D3);3)}
Note that you should extend the array formula to columns F, G, H and so on so that you get all results. (The { and } are not to be inserted manually, they are the mark of the array formula) :
Select cells E2, F2, G2, H2, and so on to Z2
Type the formula
To validate input, press Ctrl+Shift+Enter
Put the following code into a code module.
Public Function k_combinations(ByVal chLetters As String, ByVal k As Long) As Variant
Dim chCombinations() As String
Dim uCount As Long
Dim vReturn() As Variant
Dim i As Long
uCount = Get_k_combinations(chLetters, chCombinations, k)
ReDim vReturn(0 To uCount - 1) As Variant
For i = 0 To uCount - 1
vReturn(i) = chCombinations(i)
Next i
k_combinations = vReturn
End Function
Private Function Get_k_combinations(chLetters As String, chCombinations() As String, ByVal k As Long) As Long
Dim i As Long
Dim M As Long
M = Len(chLetters)
If k > 1 Then
Get_k_combinations = 0
For i = 1 To M - (k - 1)
Dim chLetter As String
Dim uNewCombinations As Long
Dim chSubCombinations() As String
Dim j As Long
chLetter = Mid$(chLetters, i, 1)
uNewCombinations = Get_k_combinations(Right$(chLetters, M - i), chSubCombinations, k - 1)
ReDim Preserve chCombinations(0 To Get_k_combinations + uNewCombinations) As String
For j = 0 To uNewCombinations - 1
chCombinations(Get_k_combinations + j) = chLetter & chSubCombinations(j)
Next j
Get_k_combinations = Get_k_combinations + uNewCombinations
Next i
Else
ReDim chCombinations(0 To M - 1) As String
For i = 1 To M
chCombinations(i - 1) = Mid$(chLetters, i, 1)
Next i
Get_k_combinations = M
End If
End Function
Get_k_combinations is called recursively. The performance of this method is quite poor (because it uses string arrays and makes a lot of reallocations). If you consider bigger data sets, you will have to optimize it.