Need Help Expanding Macro

[Guest]

I need help expanding the function of a macro I have written. Essentially
what this macro does is start at the top of a column and adds two cells
together to see if they match a number that is input by the user. It starts
with row1 and row2, then row1 and row3, etc. until it has checked to the
bottom of the column. I would like to expand this out so that it will run
through checking 2 rows, then 3, then 4, etc up to 9 or 10. I can write this
out in multiple loops, but I would like to know if there is a faster/simpler
way to do it. I will paste the code below so you can see what I am doing.
If there is a function or some other way to do this, I would be greatful. My
ultimate goal is just to be able to enter a number into an input box and have
excel go through all the iterations of the column to find the sum I am
looking for in all the possible combinations.

Sub combo_add()
'Application.ScreenUpdating = False
x = (ActiveCell.Row - 1) * 256 + ActiveCell.Column
y = x + 256
z = Application.InputBox(prompt:="Input Total", Type:=1)
aa = 1
Do Until Cells(x).Value = ""
Do Until Cells(y).Value = ""
Cells(x).Select
a = Cells(x).Value
b = Cells(y).Value
If a + b = z Then
Cells(x + 1) = aa
Cells(y + 1) = aa
aa = aa + 1
End If
y = y + 256
Loop
x = x + 256
y = x + 256
Loop
MsgBox aa - 1
Range("A1").Select
End Sub

 

[Dave D-C]

Digger,

cells( x + 256)

You don't sell that kind of cell reference here much.

.. multiple loops ..

This kind of problem indicates a recursive approach.
Like the Tower of Hanoi problem

, but I would like to know if there is a faster/simpler ..

This is not faster, but is simpler.
This assumes your numbers are in column 1.
It will show the "winning" combinations to the right.

Option Explicit
Const gCol1 = 1 ' data column
Dim gRowZ&, gCol%, gGrp%, gNum&, gSum&, gStack As New Collection

Sub Main()
gGrp = 0
gCol = gCol1
gNum = Application.InputBox(prompt:="Input Total", Type:=1)
gRowZ = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Call DoRowsStartingWith(1)
beep ' done
End Sub

Sub DoRowsStartingWith(pRow&)
Dim i1%, iRowV&
gSum = gSum + Cells(pRow, gCol) ' add
gStack.Add pRow, Format(pRow) ' push this row
If gSum = gNum Then ' check for winner
gGrp = gGrp + 1 ' have a winner
For i1 = 1 To gStack.Count ' display group
Cells(gStack(i1), gCol + gGrp) = gGrp
Next i1
End If
If gSum < gNum Then
' recursively call DoRows..
For iRowV = pRow + 1 To gRowZ
Call DoRowsStartingWith(iRowV)
Next iRowV
End If
gStack.Remove gStack.Count ' pop this row
gSum = gSum - Cells(pRow, gCol) ' subtract
End Sub

D-C Dave

 

[Guest]

This works great. Thanks for the fast and effective reply.
Eric

 

[Dave D-C]

Version 1 missed combinations without row 1.
Version 2:

Option Explicit
Const gCol1 = 1 ' data column
Dim gRowZ&, gGrp%, gNum&, gSum&, gStack As New Collection

Sub Main()
gGrp = 0
gNum = Application.InputBox(prompt:="Input Total", Type:=1)
gRowZ = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Call DoRowsStartingWith(0)
End Sub

Sub DoRowsStartingWith(pRow&)
Dim i1%, iRowV&
If pRow > 0 Then
gSum = gSum + Cells(pRow, gCol1) ' add
gStack.Add pRow, Format(pRow) ' push this row
If gSum = gNum Then ' check for winner
gGrp = gGrp + 1 ' have a winner
For i1 = 1 To gStack.Count ' display group
Cells(gStack(i1), gCol1 + gGrp) = gGrp
Next i1
End If
End If
If gSum < gNum Then
' recursively call DoRows..
For iRowV = pRow + 1 To gRowZ
Call DoRowsStartingWith(iRowV)
Next iRowV
End If
If pRow > 0 Then
gStack.Remove gStack.Count ' pop this row
gSum = gSum - Cells(pRow, gCol1) ' subtract
End If
End Sub

 

[Dave D-C]

digger wrote: from numbers in column 1, pick

combinations that add up to N.

The development cycle of a recursive program:
Version 1 - Works almost perfectly.
Version 2 - A Kludge to fix it.
Version 3 - (overnight) A re-arrangement.
This version 3 keeps the visual effects.
If negative numbers are allowed, then it has
to go thru all 2^Rows possibilities. D-C Dave

Option Explicit
Const gCol1 = 1
Dim gSw1%, gRowZ&, gGrp%, gNum&, gSum&, gStack As New Collection

Sub Main()
If gSw1 Then Stop: End ' hit F5 twice (clear globals, run)
gSw1 = 1
Me.Activate ' this sheet
gNum = Application.InputBox(prompt:="Input Total", Type:=1)
gRowZ = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Call DoRowsStartingWith(1)
Beep ' done
End Sub

Sub DoRowsStartingWith(pRow&)
Dim i1%, iRowV&
' go thru this row and below
For iRowV = pRow To gRowZ
gStack.Add iRowV, Format(iRowV) ' push this row
gSum = gSum + Cells(iRowV, gCol1) ' add
Cells(iRowV, gCol1).Interior.ColorIndex = 6 ' flag
Cells(iRowV, gCol1).Select
' check for winner at this level
If gSum = gNum Then
gGrp = gGrp + 1 ' have a winner
For i1 = 1 To gStack.Count ' display group
Cells(gStack(i1), gCol1 + gGrp) = gGrp
Next i1
End If
' consider more levels
If iRowV < gRowZ Then '
' and gSum < gNum Then ' if all numbers > 0
' recursive call
Call DoRowsStartingWith(iRowV + 1)
End If
Cells(iRowV, gCol1).Interior.ColorIndex = 0 ' unflag
gSum = gSum - Cells(iRowV, gCol1) ' subtract
gStack.Remove gStack.Count ' pop this row
Next iRowV
End Sub