Need Help Expanding Macro

D

digger27

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
 
D

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top