Bucle encuentre valor más cercano a cero

Esta como compleja la pregunta, ¿me puedes decir que hace la función calculate?

Tengo una lista con aprox. 100 valores y con calculate, busca una suma de valores que coincide con un numero indicado.
Ejemplo:
Buscar suma de numero que sea igual a 10 entre los siguientes:
1 2 3 4 5 6 7 8 9
Repuesta: 1 + 4 + 5,  o 1 + 9
El ejemplo me lo baje de internet y funciona tal que asi:
Hay dos columnas, una con los numeros a sumar y otra, al lado, con el valor =aleatorio.entre(1;0)
Después hay en otra celda una función Sumaproducto de las dos columnas y usa la función Solver.
Según me parece, calculate hace que empiece a usarse el calculo.
El programa funciona bien, pero tengo el problema de que si no me encuentra la solución, el bucle no para. Me interesaría que si no la encuentra, buscase el valor más próximo.
Gracias

Creo que la única forma de ayudarte es que me envíes una copia a [email protected]

Te lo envío ahora mismo

Te comento algo, el código esta bien, el problema radica en algo, al ser números aleatorios es poco probable que tengas una respuesta rápidamente, es más si dejaras un rato la macro andando muy probablemente tendrías una respuesta, quizás en 5 min o 1 hora o un día.
Si te das cuenta al ser números del 1 al 20 existen muchas combinaciones probables, desde 00000000000000000000 hasta 11111111111111111111, en este puntopuedes manejar las combinaciones como números decimales.
00000000000000000001=1
00000000000000000010
00000000000000000011
00000000000000000100
.
.
.
11111111111111111111=1.048.575
O sea hay 1.048.575 combinaciones probables, ademas el mayor numero que puedes buscar es 1+2+3+4.....+20=210
A partir de esto creo que es mejor tener controlado los numeros a buscar y no aleatoriamente. Te hice un código, para esto elimina los aleatorio. Entre(1,0) de la columna H. E inserta este código en un modulo. Básicamente son dos funciones, la función DecxBin, convierte un numero decimal a binario y lo pone en las ubicación que le hallamos indicado con f y c. La función Calcularx() Es la que tienes que llamar con tu botón, básicamente hace un ciclo desde 1 hasta 1.048.575 y los convierte a binario, la función sumar. Producto ira calculando el resultado, en el momento que encuentre una solución te preguntara si deseas buscar otra.
Pero tienes que tener en cuenta algo, el tiempo que tarda en buscar es exponencial al numero de bits del numero binario, o sea para buscar soluciones del numero 10 puede tardar un segundo pero para solucionar el 86 tardara quizás 30 segundos, te cuento que el mayor numero 210 que tiene solo una solución, quizás tarde entre 30 y 40 minutos XD. De todos modos usalo y me cuentas ;).
Private Function DecxBin(numero As Long, f As Integer, c As Integer) As String
If numero <= 2 Then 'Caso Base
DecxBin = (numero Mod 2)
Cells(f, c) = DecxBin
Else 'Caso Recursivo
DecxBin = DecxBin(numero \ 2, f + 1, c) & numero Mod 2
Cells(f, c) = numero Mod 2
End If
End Function
Sub Calcularx()
    Application.ScreenUpdating = False
    Range("h6:h25").Value = "0"
    Dim i As Long
    i = 1
    While i <= 1048575
        Call DecxBin(i, 6, 8)
        If (Range("G3") = 0) Then
            Application.ScreenUpdating = True
            If (MsgBox("Solucion encontrada. Desea buscar otra solucion?", 1)) = 2 Then
                Exit Sub
            End If
            Application.ScreenUpdating = False
        End If
        i = i + 1
    Wend
    Application.ScreenUpdating = True
End Sub

La he estado probando y funciona pero lo que no hace es, en el caso de que no exista solución, buscar el numero la solución más cercana.
He probado solo con tres números modificando el código y no encuentra nada.
¿La función que has hecho buscaría la solución más cercana si no encuentra la solución exacta o no?

No entiendo cuando dices solución más cercana, todos los números entre 0 y 210 tienen solución.
Dime un numero que no tenga solución

El archivo que te mande NO tiene los datos correctos (importes). Pero imaginate que pones los importes: 10, 421, -30, 18, 498 ... y tienes que buscar combinaciones que se aproximen a 233. A lo mejor no existe solución exacta, pero si se pueden buscar la combinación que más se aproxime.
Siento no haberte enviado el ejemplo con los datos correctos.
Espero

De verdad que tu pregunta me tomo tiempo, es bastante interesante, y logre realizar un código que hace exactamente lo que quieres. La única limitante, es el tiempo que puede durar al realizar cálculos con muchas variables, porque como te dije puede llegar a realizar con 20 datos 1.048.575 iteraciones, y en cada iteración hace bastantes cálculos lo que puede producir mucho tiempo de espera.
En el siguiente link esta la hoja funcionando:
http://rapidshare.com/files/383751205/Macro_suma_.xls
De todas maneras a continuación pongo el código, la deje por defecto con 15 datos y no con 20, pero si quieres poner más datos solo modifica los rangos que están al comienzo del código.
Sub Calcularx()
    Dim i, ifin As Long
    Dim rango, celda As String
    Dim menor As Double 'Guardara el menor de las soluciones
    Dim menori As Long 'Guardara la combinacion para el menor
    celda = "G3" 'celda donde estara la diferencia
    celda2 = "h3" 'celda donde estara el sumaproducto
    rango = "h6:h15" 'Rango donde estaran los 1 y 0
    rango2 = "f6:f15" 'Rango donde estaran los valores
    i = 1 'primera posible solucion 1
    ifin = Numbinario(Range(rango).Rows.Count) 'ultima posible solucion
    Range(celda2).FormulaLocal = "=SUMAPRODUCTO(" & rango2 & ";" & rango & ")"
    Application.ScreenUpdating = False
    While i <= ifin
        Range(rango).Value = "0"
        Call DecxBin(i, Range(rango).Row, Range(rango).Column)
        If (i = 1) Then
            menor = Abs(Range(celda).Value)
            menori = i
        End If
        If (Abs(Range(celda).Value) < menor) Then
            menor = Abs(Range(celda).Value)
            menori = i
        End If
        If (Range(celda) = 0) Then
            Application.ScreenUpdating = True
            If (MsgBox("Solucion encontrada. Desea buscar otra solucion?", 1)) = 2 Then
                Exit Sub
            End If
            Application.ScreenUpdating = False
        End If
        i = i + 1
    Wend
    Range(rango).Value = "0"
    Call DecxBin(menori, Range(rango).Row, Range(rango).Column)
    Application.ScreenUpdating = True
    'Application.Calculation = xlAutomatic
    MsgBox ("Solucion exacta no encontrada." & vbCrLf & "Solucion mas cercana:")
End Sub
Function Numbinario(n As Integer) As Long
    Dim a As Long
    For i = 0 To n - 1
        a = a + 2 ^ i
    Next
    Numbinario = a
End Function
Public Function DecxBin(ByVal numero As Long, f As Integer, c As Integer) As String
If numero <= 2 Then 'Caso Base
DecxBin = (numero \ 2) & (numero Mod 2)
Cells(f, c) = (numero Mod 2)
    If (numero \ 2) = 1 Then Cells(f + 1, c) = 1
Else 'Caso Recursivo
DecxBin = DecxBin(numero \ 2, f + 1, c) & numero Mod 2
Cells(f, c) = numero Mod 2
End If
End Function