Arrays

Topic

New Reply

I have a column with a different integer value in each of 21 rows. How can I loop through the values until I get 12 of the values to sum to a specific amount?

Reply | Quote

Replies

We need a little more information:

1- Does it have to be 12 consecutive values, or should it be any combination of the 21 cells?

2- Can a particular cell be used more that once?

3- What result do you want and how do you want it. Surly you don’t want the sum since you know that going in. Do you want a list of the indexes of the cells used? Do you want a list of the values used? In an array?

I assume you are talking about doing this in VBA.

Reply | Quote

1- No, it should be any combination of the 21 cells.
2- No, a cell can only be used once.
3- Prefered result would be a list of the values.

Yes I was prefering to use VBA.

Reply | Quote

I am not going to write the VBA for you but I can give a few pointers.

I would suggest you set the first 12 cells in a column to the right of the list to equal the corresponding list number. Put a total of this column at the bottom and test if it = the target.

Then you need to work out a process for stepping through the list moving the spaces up into the list. Clearly the first step will be to make the 12th cell blank and the 13th cell = its corresponding figure. Then you make the 11 cell blank and make the 12 cell = its corresponding figure.

You would probably have a series of nested loops to do this but if you were very clever and wanted to minimise the size of the code you would use a recursive sub.

Back in the old days we used to do things like this for fun – see how much you can do with how little programming!

Reply | Quote

Ok, the code below will find the combination of 12 cells in the range A1:A21 that adds up to the sum passed as a parameter to the subroutine. First, a couple of warnings. The procedure is written to expect to find an exact match on the sum and therefore is only guaranted to work on integer values. If the cells can contain real numbers, the procedure will have to be modified to deal with the rounging errors. Second, be patient. This procedure can run for a long time. To find the sum where the values were in the last 12 cells took over 5 minutes on the 400mz system I tested it on.

Public Sub Find12(dReqTot As Double)
Dim I1 As Integer, I2 As Integer, I3 As Integer, I4 As Integer, I5 As Integer, I6 As Integer
Dim I7 As Integer, I8 As Integer, I9 As Integer, I10 As Integer, I11 As Integer, I12 As Integer
Dim dSum As Double, dList(1 To 12) As Double
Dim strWk As String
For I1 = 1 To 10
  For I2 = I1 + 1 To 11
    For I3 = I2 + 1 To 12
      For I4 = I3 + 1 To 13
        For I5 = I4 + 1 To 14
          For I6 = I5 + 1 To 15
            For I7 = I6 + 1 To 16
              For I8 = I7 + 1 To 17
                For I9 = I8 + 1 To 18
                  For I10 = I9 + 1 To 19
                    For I11 = I10 + 1 To 20
                      For I12 = I11 + 1 To 21
                        dSum = Cells(I1, 1) + Cells(I2, 1) + Cells(I3, 1)
                        dSum = dSum + Cells(I4, 1) + Cells(I5, 1) + Cells(I6, 1)
                        dSum = dSum + Cells(I7, 1) + Cells(I8, 1) + Cells(I9, 1)
                        dSum = dSum + Cells(I10, 1) + Cells(I11, 1) + Cells(I12, 1)
                        If dSum = dReqTot Then Exit For
                      Next I12
                      If dSum = dReqTot Then Exit For
                    Next I11
                    If dSum = dReqTot Then Exit For
                  Next I10
                  If dSum = dReqTot Then Exit For
                Next I9
                If dSum = dReqTot Then Exit For
              Next I8
              If dSum = dReqTot Then Exit For
            Next I7
            If dSum = dReqTot Then Exit For
          Next I6
          If dSum = dReqTot Then Exit For
        Next I5
        If dSum = dReqTot Then Exit For
      Next I4
      If dSum = dReqTot Then Exit For
    Next I3
    If dSum = dReqTot Then Exit For
  Next I2
  If dSum = dReqTot Then Exit For
Next I1
If dSum = dReqTot Then
  strWk = Cells(I1, 1) & "+" & Cells(I2, 1) & "+" & Cells(I3, 1) & "+"
  strWk = strWk & Cells(I4, 1) & "+" & Cells(I5, 1) & "+" & Cells(I6, 1) & "+"
  strWk = strWk & Cells(I7, 1) & "+" & Cells(I8, 1) & "+" & Cells(I9, 1) & "+"
  strWk = strWk & Cells(I10, 1) & "+" & Cells(I11, 1) & "+" & Cells(I12, 1) & "=" & dReqTot
  MsgBox strWk
Else
  MsgBox "No combination adds up to " & dReqTot
End If
End Sub

Reply | Quote