Replace

Cells(iRow, 1).Resize(, m).Value = vOut
iRow = iRow + 1

with
Cells(iRow, 1).Resize(, m).Value = vOut
Cells(iRow, 1).Offset(0, m).Value =
WorksheetFunction.Median(Cells(iRow, 1).Resize(, m))
iRow = iRow + 1

near the end of your code. The middle line is an addition, everything else
remains the same.
--
HTH,
Barb Reinhardt



"Andreas" wrote:

Hi,

I posted this already he

http://groups.google.com/group/micro...35 7c7d62558d

and received some good solutions. However, my original problem has
become a bit more complicated.

Here's the original problem:

I'm trying to figure out how to generate all combinations from a list
of N values in a column, let's say column A.

In particular, I want to have all combinations of 2 values, 3 values,
4, ... up to 7 values.

To give an example: Let's assume I have a list of only 3 values
(1,2,3) for which I want to have all combinations of two values. In
this case, the result would be 1,2; 1,3; and 2;3. The ordering of the
values does not matter, i.e. duplicates should be eliminated.

Now, the extension is that I need the median of each combination
rather than the combinations themselves. So it would be nice if the
code would already calculate the median.

Besides the solution in the link, I also found another code that works
well - but still does not provide me with the median (see below).

An additional problem is the limitation in the number of rows in
excel. Thus, it would be great to have the output in a txt file or
something similar, which may ideally be imported to SPSS.

Any suggestions? Thanks in advance,
Andreas

Sub test()
ListCombos Range("A1:A5"), 3, 7
End Sub

Sub ListCombos(r As Range, m As Long, iRow As Long)
' lists the combinations of r choose m starting in row iRow
Dim ai() As Long
Dim i As Long
Dim n As Long
Dim vOut As Variant

n = r.Rows.Count

Redim ai(1 To m)
Redim vOut(1 To m)

ai(1) = 0
For i = 2 To m
ai(i) = i
Next i

Do
For i = 1 To m - 1
If ai(i) + 1 < ai(i + 1) Then
ai(i) = ai(i) + 1
Exit For
Else
ai(i) = i
End If
Next i
If i = m Then
If ai(m) < n Then
ai(m) = ai(m) + 1
Else
Exit Sub
End If
End If

' put the values in the variant
For i = 1 To m
vOut(i) = r(ai(i))
Next i
' list it
Cells(iRow, 1).Resize(, m).Value = vOut
iRow = iRow + 1
Loop
End Sub