Enabling Macro to work in any spreadsheet

[jamiensurrey]

Hi

Im wanting to enable this macro to work in any spreadsheet.

Basically this code takes a set of numbers and sees if it can match against a target number in any combination.

I have linked the macro to a custom button on excel but every time I press it it carries out the macro on the original spreasheet it was created on.


Option Explicit

'These private variables are used by the AddsUp macro
Dim Target As Double ' The target total we're aiming for
Dim EndRow As Integer ' The last row of the value list
Dim Limit As Integer ' sum no more than this many cells
Dim OutRow As Integer ' The row for the next output line

Sub AddsUp()

' *** Results in column C - change to suit ***
ActiveSheet.Columns(3).Clear
' *** Required answer - change reference to suit ***
Target = ActiveSheet.Range("B1").Value
' *** The last row in the list of values - change Range reference to suit ***
EndRow = ActiveSheet.Range("A1").End(xlDown).Row
' You can change the next two values
Limit = 20 ' Max number of cells to be summed
OutRow = 1 ' The row for the next output line
' You can change the first argument in the function call that follows.
' Doing so will change the starting row. Do not change the other
' three arguments
Add1 1, 0, "", 0
End Sub

Sub Add1(ByVal BegRow As Integer, ByVal SumSoFar As Double, _
ByVal OutSoFar As String, ByVal Num As Integer)
'This subroutine is called once by the AddsUp macro, to get the process
'started. It then calls itself recursively as many times as needed.
'
'BegRow - the first row that will be tested
'SumSoFar - the sum of all cells under consideration
'OutSoFar - the addresses of all cells under consideration
'Num - the number of cells under consideration
Dim ThisRow As Long
Dim OneA As String
If (BegRow <= EndRow) And (Num < Limit) Then
For ThisRow = BegRow To EndRow
OneA = Cells(ThisRow, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
If OutSoFar <> "" Then
OneA = " + " & OneA
End If
' If the current cell's value plus the sum so far equals
' the target, then we have found an answer. Display it
' in the current output row, and set OutRow to the next row
If (Round(SumSoFar + Cells(ThisRow, 1).Value, 2) < Target + 1) And (Round(SumSoFar + Cells(ThisRow, 1).Value, 2) > Target - 1) And (Num > 0) Then
Cells(OutRow, 3).Value = OutSoFar & OneA
OutRow = OutRow + 1
Else
' If the current cell's value plus the sum so far does not
' equal the target value, call this function again, starting
' in the row after ThisRow
Add1 ThisRow + 1, Round(SumSoFar + Cells(ThisRow, 1).Value, 2), _
OutSoFar & OneA, Num + 1
End If
Next ThisRow
End If
End Sub


It would be great if anyone could help! Thanks!

Jamie

 

[GlennUK]

Can you explain exactly how and where your custom button was created please?

 

[jamiensurrey]

I created the custom button in the spreadsheet that the macro is oringinaly on by right clicking the tool bar and selecting "customize" and then "Macros" then "custom button". Then I assigned the button to this macro.

Hope that helps.

Cheers!

 

[GlennUK]

Create a custom button on a toolbar instead. You are referencing ActiveSheet in your macro, but that will always be the original sheet if your button is there. If you put the button on a toolbar, then the activesheet will be processed, even if that isn't the original. Do Tools/Cusotmize/Commands and pick category Macros, and drag the Custom Button from the dialog onto any existing toolbar, then right-click it and assign your macro before quitting the customize dialog.

 

[GlennUK]

Sorry, when I read "in the spreadsheet" ... I didn't read the rest of your post ... which explained that you didn't put it in your spreadsheet.