Formula to get all possible combinations of 2 separate cells? Includes Screenshot of the issue

[marshen]

Hi all.
This forum has provided me with great assistance in the past and hopefully you can help me today.

I have a sheet that has 90 rows and I want to add a formula to it that will give me all the possible combinations of the 2 cells on the corresponding row, for each of the 90 rows.

Below is an example....

The values are that require the combinations to be calculated are in columns B & C

The possible combinations in my example are in columns D-I, however I'd like a formula to populate these combinations for me, which IO can then just drag down for each of the 90 rows.

It's worth nothing that some of the cells are blank and therefore I'd like the result as shown below, ie, the only possible combination is HH.

On a final note, the maximum characters in either column is 9, which of course will returns many different combinations of the 2 columns in that particular row.

I hope this all makes sense and you can assist me.

Thanks again.

Mark

 

[Legacy 143009]

OK. I fixed the preoblem. This will work now

Sub GetString()
  Dim xStr As String
  Dim FRow As Long, i As Long
  Dim xScreen As Boolean
 
  Application.ScreenUpdating = False
  lRow = Cells(Rows.Count, 2).End(xlUp).Row
  
  For i = 1 To lRow
    xStr = Cells(i, 2).Value & Cells(i, 3).Value
      If Len(xStr) >= 8 Then
        MsgBox "Too many permutations!", vbInformation, "Permutation"
        Exit Sub
      Else
        ActiveSheet.Columns(1).Clear
        FRow = 1
        Call GetPermutation("", xStr, FRow, i)
      End If
    Next
    Application.ScreenUpdating = True
End Sub
Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long, r As Long)
  Dim i As Integer, xLen As Integer
  Dim valExist As Boolean
  xLen = Len(Str2)
  If xLen < 2 Then
    valExist = False
    For c = 4 To xRow + 2
      If Cells(r, c).Value = Str1 & Str2 Then valExist = True
    Next
    If Not valExist Then
      Cells(r, xRow + 3).Value = Str1 & Str2
      xRow = xRow + 1
    End If
  Else
    For i = 1 To xLen
      Call GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right(Str2, xLen - i), xRow, r)
    Next
  End If
End Sub