Hi jugrnt,

I got interested in the problem of writing a single sub that can handle
your orginal request from last month, the one from today and any
sufficiently similar one in the future. It takes as input a favorite
list like A,B,E,G,I,K,M a corresponding dog list like B,D,F,H,J,L,N
(note that I am back to 2 lists rather than a list of pairs but that I
am now using commas as delimiters - you can easily modify the code to
go back to spaces, but I personally don't trust spaces as delimiters
because of the hassle of worrying about extra spaces). Furthermore - as
input you also now supply the number of favorites as well as the number
of dogs per row, so that if you want 3 favorites and 3 dogs from the
above the output will begin

A C E H J L
A C E H J N
A C E H L N
A C E J L N
A C G F J L
A C G F J N
A C G F L N
A C G J L N

and so so for 144 rows (including spaces inserted when the A in the
first column turns into a B, etc. Your original request was 1 favorite
and 3 dogs and today it was for 2 and 3

I dont know if you need this generality - but it struck me as being an
interesting problem:

*************************************************************************

Sub CombineValues3()
   Dim LHS As Variant
   Dim RHS As Variant
   Dim LTuple As Variant
   Dim RTuple As Variant
   Dim n As Long
   Dim i As Long, j As Long, k As Long
   Dim currentRow As Long
   Dim currentFav As String
   Dim rowString As String
   Dim numFavs As Long, numDogs As Long

   LHS = InputBox("Enter Favorites, separated by commas")
   LHS = Split(LHS, ",")
   RHS = InputBox("Enter Dogs, separated by commas")
   RHS = Split(RHS, ",")
   n = UBound(LHS)
   If n <> UBound(RHS) Then
       MsgBox "Invalid Input" & vbCrLf & _
       "Number of Favorites must = number of Dogs"
       Exit Sub
   End If
   For i = 0 To n
       LHS(i) = Trim(LHS(i))
       RHS(i) = Trim(RHS(i))
   Next i
   numFavs = InputBox("Enter number of Favorites per row")
   numDogs = InputBox("Enter number of Dogs per row")
   If numFavs + numDogs > n + 1 Then
       MsgBox "Not enough teams for that type of output"
       Exit Sub
   End If
   Application.ScreenUpdating = False
   Range("A:A").ClearContents
   ReDim LTuple(0 To numFavs - 1)
   ReDim RTuple(0 To numDogs - 1)
   For i = 0 To numFavs - 1
       LTuple(i) = i
   Next i
   currentFav = LTuple(0)
   For i = 1 To Application.WorksheetFunction.Combin(n + 1, numFavs)
       For j = 0 To numDogs - 1
       RTuple(j) = j
       Next j
       For j = 1 To Application.WorksheetFunction.Combin(n + 1,
numDogs)
           If Disjoint(LTuple, RTuple, n) Then
               If LTuple(0) <> currentFav Then
                   currentRow = currentRow + 1
                   currentFav = LTuple(0)
               End If
               rowString = ""
               For k = 0 To numFavs - 1
                   rowString = rowString & LHS(LTuple(k)) & " "
               Next k
               For k = 0 To numDogs - 1
                   rowString = rowString & RHS(RTuple(k)) & " "
               Next k
               rowString = RTrim(rowString)
               Range("A1").Offset(currentRow).Value = rowString
               currentRow = currentRow + 1
           End If
           NextTuple RTuple, numDogs, n
       Next j
       NextTuple LTuple, numFavs, n
   Next i
   Application.ScreenUpdating = True
End Sub

Sub NextTuple(T As Variant, k As Long, n As Long)
   'This sub takes a 0-based variant array representing
   'a k-element subset of {0,1,...,n} and changes
   'it to the next one in lex order
   'it has no effect if the tuple has no successor

   On Error GoTo no_successor
   Dim i As Long, j As Long, M As Long
   M = n
   i = k - 1
   Do While T(i) = M
       i = i - 1
       M = M - 1
   Loop
   T(i) = T(i) + 1
   For j = i + 1 To k - 1
       T(j) = T(j - 1) + 1
   Next j
no_successor:
End Sub

Function Disjoint(S As Variant, T As Variant, n As Long) As Boolean
   'This function takes 2 arrays representing
   'subsets of {0,1,...,n} and returns True
   'if they are disjoint and False otherwise
   Dim A() As Long
   Dim i As Long

   ReDim A(0 To n)
   For i = LBound(S) To UBound(S)
       A(S(i)) = 1
   Next i
   For i = LBound(T) To UBound(T)
       If A(T(i)) = 1 Then
           Disjoint = False
           Exit Function
       End If
   Next i
   Disjoint = True
End Function

******************************************************************

HTH

-John Coleman