Hi all,

that`s my first post in this forum and its a little bit tricky. I hope u can help me out with this one
First off all I got a VBA Code to match a particular Sum with multiple summands from a given list of numbers. From the code so far I am able to type in a Sum and get the matches displayed.
Unfortunately I need to loop through a complete column of those "potential" Sums and paste the summands (Matches) one column next to it (or n columns for n summands).
I tried to change the range and add a "i" loop to it. But it seems that everytime I m doing it, mismatch Data pops up. So I wasnt able to set the Range to the whole column. For instance I tried .Range("B" & iCount) or Range("B:B") or Cells(iCount, 2) and so on
So my question here is whether I did the syntax wrong or could be problem with the arrays themselves?

Here is the Code related to setting up the range:

For iCount = 1 To 10

With Me

   dblZielwert(iCount) = ActiveSheet.Range("B" & iCount)
Here is the whole code, sub + function:
Option Explicit

Private Sub cmbBerechnen_Click()
Dim dblZielwert   As Double
Dim dblToleranz   As Double
Dim adblBeträge() As Double
Dim varResult     As Variant
Dim m             As Long
Dim n             As Long
Dim iCount        As Integer

For iCount = 1 To 10

With Me

   dblZielwert(iCount) = ActiveSheet.Range("B" & iCount)
  
   ReDim adblBeträge(1 To 100)
   For m = 2 To 101
      If (.Cells(m, 1) <> "") And (IsNumeric(.Cells(m, 1))) Then
         adblBeträge(m - 1) = .Cells(m, 1)
      Else
         ReDim Preserve adblBeträge(1 To m - 1)
         Exit For
      End If
   Next
   ReDim Preserve adblBeträge(1 To UBound(adblBeträge) - 1)
   
   varResult = Kombinationen(adblBeträge, dblZielwert, dblToleranz)
   Application.ScreenUpdating = False
      .Range(.Cells(3, 4), .Cells(UBound(varResult) + 3, 4)) = _
         varResult
   Application.ScreenUpdating = True

End With
Next iCount

End Sub
Option Explicit
Sub testen()
Dim varErg As Variant
varErg = Kombinationen(Array(10, 11, 13, 12), 25, 0.5)
End Sub

Public Function Kombinationen( _
   Elemente As Variant, _
   Sollwert As Variant, _
   Optional Toleranz As Double, _
   Optional Bisher As Variant, _
   Optional Pos As Long) As Variant
   
Dim i             As Long
Dim k             As Long
Dim dblVergleich  As Double
Dim dblDummy      As Double
Dim varDummy      As Variant
Dim varResult     As Variant


If Not IsMissing(Bisher) Then

   'Summe bisherige Elemente
   For Each varDummy In Bisher
      dblVergleich = dblVergleich + varDummy
   Next
   
Else

   'Ausgangselemente nach Größe sortieren
   For i = 1 To UBound(Elemente)
       For k = i + 1 To UBound(Elemente)
           If Elemente(k) < Elemente(i) Then
               dblDummy = Elemente(i)
               Elemente(i) = Elemente(k)
               Elemente(k) = dblDummy
           End If
       Next
   Next
   
   Set Bisher = New Collection
   
End If

If Pos = 0 Then Pos = LBound(Elemente)
For i = Pos To UBound(Elemente)

   ' Aktuellen Wert hinzufügen
   Bisher.Add Elemente(i)
   dblVergleich = dblVergleich + Elemente(i)
   
   If Abs(Sollwert - dblVergleich) < (0.001 + Toleranz) Then
   
      'Sollwert ist erreicht
      k = 0
      ReDim varResult(0 To Bisher.Count - 1, 0)
      For Each varDummy In Bisher
         varResult(k, 0) = varDummy
         k = k + 1
      Next
      Kombinationen = varResult
      Exit For
      
   ElseIf dblVergleich < (Sollwert + 0.001 + Toleranz) Then
      ' Es ist noch Platz für einen Betrag
      ' Rekursiv aufrufen, beginnen mit nächsthöherem Wert
      varResult = Kombinationen( _
         Elemente, Sollwert, Toleranz, Bisher, i + 1)
      If IsArray(varResult) Then
         Kombinationen = varResult
         Exit For
      Else
         Bisher.Remove Bisher.Count
         dblVergleich = dblVergleich - Elemente(i)
      End If
      
   Else
   
      ' Wert ist zu groß
      Bisher.Remove Bisher.Count
      Exit For
      
   End If
   
Next ' Nächsthöhere Zahl probieren

End Function


Thanks for ur help, I really do appreciate it!