Author: Oscar Cronquist Article last updated on October 28, 2011

vicktor schausberger writes:
Zen Archery
In his book Wonders of Numbers (Oxford: Oxford University Press, 2001), pp. 275-276, Clifford Pickover posed a "Zen Archery" problem. In its simplest form, there is a target with 24 numbers on it. The archer must shoot 5 arrows at the target and hit numbers adding up to 200. The 24 numbers on the target are
97,101,139,41,37,31,29,89,23,19,8,13,
131,19,73,97,19,139,79,67,61,17,113,127
Pickover posed a similar problem at Archery by the Numbers. This is really a combinatorial problem -- given the 24 numbers taken 5 at a time, which unique combinations add up to 200?
There is some quick and dirty Java code on the Web, associated with Pickover's book, which solves the Zen archery problem for the 24 numbers given. However, it is not exactly a model of good programming, and it even assumes some foreknowledge of the answer in the code, i.e. the fact that all combinations adding up to 200 include the number 8.

The text above seems to be copied from this website: http://www.merriampark.com/comb.htm

Let´s create a user defined function that checks every combination and filters values where the sum is equal to 200.

I don´t understand why 19 occurs twice in the 24 numbers on the target. Because of this, the udf returns duplicate rows, therefore some combinations are not unique.

User defined function

```Function SumComb(sum As Range, rng As Variant, num As Integer)
Dim Arr(), i, Ans As Single
Dim svVal() As Variant
Dim tmp As Variant
ReDim Arr(num - 1)
ReDim svVal(num - 1, 0)

rng = rng.Value

For i = 0 To num - 1
Arr(i) = i + 1
Next i

Comb = Application.WorksheetFunction.Combin(UBound(rng, 1), num)

For j = 1 To Comb

tmp = 0

For i = 0 To num - 1
tmp = tmp + rng(Arr(i), 1)
Next i

If tmp = sum Then
For i = 0 To num - 1
svVal(i, UBound(svVal, 2)) = rng(Arr(i), 1)
Next i
ReDim Preserve svVal(UBound(svVal, 1), UBound(svVal, 2) + 1)
End If

Arr(num - 1) = Arr(num - 1) + 1

k = num

For i = num - 1 To 0 Step -1
If Arr(i) = UBound(rng, 1) - num + i + 2 Then
k = i
Arr(i - 1) = Arr(i - 1) + 1
Else
If k <> 0 Then
k = i
Else
k = num
End If
Exit For
End If
Next i

If k <> num Then
For i = k To num - 2
Arr(i + 1) = Arr(i) + 1
Next i
End If

Next j

ReDim Preserve svVal(UBound(svVal, 1), UBound(svVal, 2) - 1)
SumComb = Application.Transpose(svVal)

End Function```

Where to copy udf?

Press Alt+F11

Explaining user defined function

How to enter array formula