VBA: All combinations that sum between two numbers - too much processing blows up

[solutelan]

Hi,

Thanks much in advance for reading. It's really not an overly confusing concept, and I've tried to lay it out as simply as possible!

I have some VBA code (not my own) that successfully returns combination sums between a defined range. A quick summary of what that even means, then my issue.

Example: my range is 5 ("Q1") to 10 ("S1"). My number list is 1, 1, 3, 4, 9 (column "A")

VBA would return strings of 1,1,3 (sum of 5); 1,1,3,4 (sum of 9); 1,1,4 (sum of 6), and so on and so forth. Literally every unique combination that sums between 5 -10. It returns the string in a cell ("C2"), moving down a row for every string. Lots of rows usually, I'm sure you can imagine.

Hopefully that's simple enough to track.

My problem is that I want to LIMIT the length of the strings it returns. I only want strings with 1-3 numbers included. So in my above example, the 1,1,3,4 (sum of 9) would preferably not return. Without this limitation, when my number lists get longer, Excel explodes due to having so many qualifying strings to return. I want to reduce the processing required - and only need the data from the smaller 1-3 number strings anyways.

Any suggestions? I wish I was more familiar with VBA, and I've wasted a lot of time already trying to work it out myself as a layman..

My main thought so far is adding a 3rd If statement in the 2nd paragraph of code that somehow accomplishes this.

Thanks

Dim inparr() As Double, outarr() As String

Sub test()
Dim arr, i As Long
arr = Range(Cells(2, "A"), Cells(Rows.count, "A").End(xlUp)).Value
ReDim inparr(1 To UBound(arr))
For i = 1 To UBound(arr)
  inparr(i) = arr(i, 1)
Next i
ReDim outarr(1 To 1)
check_next_one "", 0, 0
If Range("C2") <> "" Then Range("C2").CurrentRegion.Clear
With Range("C2").Resize(UBound(outarr) - 1, 1)
  .Value = Application.Transpose(outarr)
End With
End Sub

Sub check_next_one(ByVal currentset As String, ByVal currentsum As Double, ByVal currentposition As Long)
Dim i As Long
If currentsum <= Range("S1") Then 'else do nothing
  If currentsum >= Range("Q1") Then 'it's one of solutions
    i = UBound(outarr)
    ReDim Preserve outarr(1 To i + 1)
    outarr(i) = currentset
  End If
  For i = currentposition + 1 To UBound(inparr)
    check_next_one currentset & inparr(i) & ",", currentsum + inparr(i), i
  Next i
End If
End Sub

 

[Fluff]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: VBA: All combinations that sum between two numbers - too much processing blows it up
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[Snakehips]

@solutelan
Maybe with modified code as below?

Sub check_next_one(ByVal currentset As String, ByVal currentsum As Double, ByVal currentposition As Long)
Dim i As Long
'
If (Len(currentset) - 3) <= Len(Application.WorksheetFunction.Substitute(currentset, ",", "")) Then  '<<<<****Limit to 3 comma in solution string
    If currentsum <= Range("S1") Then 'else do nothing
      If currentsum >= Range("Q1") Then 'it's one of solutions
     
       
        i = UBound(outarr)
        ReDim Preserve outarr(1 To i + 1)
        outarr(i) = currentset
      End If
      For i = currentposition + 1 To UBound(inparr)
        check_next_one currentset & inparr(i) & ",", currentsum + inparr(i), i
      Next i
    End If
End If

End Sub

 

[solutelan]

@solutelan
Maybe with modified code as below?

Sub check_next_one(ByVal currentset As String, ByVal currentsum As Double, ByVal currentposition As Long)
Dim i As Long
'
If (Len(currentset) - 3) <= Len(Application.WorksheetFunction.Substitute(currentset, ",", "")) Then  '<<<<****Limit to 3 comma in solution string
    If currentsum <= Range("S1") Then 'else do nothing
      If currentsum >= Range("Q1") Then 'it's one of solutions
    
      
        i = UBound(outarr)
        ReDim Preserve outarr(1 To i + 1)
        outarr(i) = currentset
      End If
      For i = currentposition + 1 To UBound(inparr)
        check_next_one currentset & inparr(i) & ",", currentsum + inparr(i), i
      Next i
    End If
End If

End Sub

My oh my. That might have been easy for you, I don't know, but I can't tell you how jazzed I am that your Len addition works. That's exactly what I needed. Thank you so much for your time in helping a random stranger!!

 

[solutelan]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: VBA: All combinations that sum between two numbers - too much processing blows it up
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

Apologies, didn't read the rules closely enough, won't let it happen again in the future.