Help creating Macro - 5 numbers adding up to a value

iainfitzy

New Member
Joined
Apr 13, 2006
Messages
44
Not sure how best to word this one!

I am looking to create a Macro to create multiple lines of data that add up to a certain value

10 20 30 -20 60 100
10 80 -40 -20 70 100
20 20 20 30 10 100
10 10 10 10 60 100
10 20 20 -10 60 100
-20 20 10 10 80 100
100 0 0 0 0 100
0 100 0 0 0 100
0 0 100 0 0 100

Columns 1-5 are the values, with column 6 the sum of the previous 5 columns


The criteria I need are as follows :-

5 columns each with values in them that add up to column 6 (100).
The numbers in Columns 1-5 should be multiples of 10
The numbers in Columns 1-5 should be from (-100 to 100)
I would like it to produce every possible number combination

Is there any possible way of doing this via a Macro? I have no idea how many lines of data this will produce - and i would guess it would need logic to check that it has not appeared before - could mean some amount of time number crunching. I would assume this has been done before but I have scoured the web with no solution.

Any help much appreciated,

Iain
 

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

hurgadion

Active Member
Joined
Mar 19, 2010
Messages
426
Hi,
try using the following macro:
Code:
Sub FiveHundred()
Dim NoDupes As New Collection
Dim l&, j&, x&, y&, tbl1()


Randomize
For l = 1 To 100000
  x = 4
  ReDim tbl(1 To x)
  For j = 1 To 4
    tbl(j) = -100 + 10 * Round((20 * Rnd), 0)
  Next j
  a = Application.Sum(tbl)
  If Abs(a - 100) <= 100 Then
    x = x + 1
    ReDim Preserve tbl(1 To 5)
    tbl(5) = 100 - a
  End If
  
     On Error Resume Next
     If x = 5 Then
         c = Join(tbl, ";")
         NoDupes.Add 1, CStr(c)
         If Err.Number = 0 Then
              y = y + 1
              ReDim Preserve tbl1(1 To 5, 1 To y)
              For j = 1 To 5
                  tbl1(j, y) = tbl(j)
              Next j
         End If
    End If
Next l

Cells(1, 1).Resize(y, 5) = Application.Transpose(tbl1)
End Sub
This generates some random Solutions satisfying Your Conditions. This macro can be useful for You, best regards.
 
Last edited:

iainfitzy

New Member
Joined
Apr 13, 2006
Messages
44
Hi,
try using the following macro:
Code:
Sub FiveHundred()
Dim NoDupes As New Collection
Dim l&, j&, x&, y&, tbl1()


Randomize
For l = 1 To 100000
  x = 4
  ReDim tbl(1 To x)
  For j = 1 To 4
    tbl(j) = -100 + 10 * Round((20 * Rnd), 0)
  Next j
  a = Application.Sum(tbl)
  If Abs(a - 100) <= 100 Then
    x = x + 1
    ReDim Preserve tbl(1 To 5)
    tbl(5) = 100 - a
  End If
  
     On Error Resume Next
     If x = 5 Then
         c = Join(tbl, ";")
         NoDupes.Add 1, CStr(c)
         If Err.Number = 0 Then
              y = y + 1
              ReDim Preserve tbl1(1 To 5, 1 To y)
              For j = 1 To 5
                  tbl1(j, y) = tbl(j)
              Next j
         End If
    End If
Next l

Cells(1, 1).Resize(y, 5) = Application.Transpose(tbl1)
End Sub
This generates some random Solutions satisfying Your Conditions. This macro can be useful for You, best regards.

Many thanks for this - is a vast improvement on what I had. I will use it to see what results I get.

Ultimately though I really need every possible combination covered if anyone else had any ideas - a variable should also never be over 100 in columns 1-5.

Again - thanks for taking the time to help me out hurgadion

Thanks,

Iain
 

Watch MrExcel Video

Forum statistics

Threads
1,122,228
Messages
5,594,939
Members
413,953
Latest member
Arthur1471

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top