VBA to sum to approximate target number

[Bamacoatie]

Good morning,
I am trying to figure out a VBA to sum a column up to an approximate target value. And have that value put in another cell.

Target number ~90 +\- 4

I.e. VBA sums P16:P25 and it equals 88. It then places that number in column R on the same row as the last number summed.
then it goes to the next set of numbers that sums closest to 90 and places that number in column R on the same row as the last number in that set that was summed. And so on.

Thanks for any help anyone can give.

 

[Alex Blakenburg]

Is each value in column P a single digit number ?
and if so is there any data validation to enforce this ?
If not what happens if there if you go from being more than 4 under to more than 4 over in one step ?
What is the first row number with a value in it in column P ?
How much data are we talking about (in no of rows) ?

 

[Bamacoatie]

Is each value in column P a single digit number ?
and if so is there any data validation to enforce this ?
If not what happens if there if you go from being more than 4 under to more than 4 over in one step ?
What is the first row number with a value in it in column P ?
How much data are we talking about (in no of rows) ?

Column P values contain at most 2 digit numbers (ie 18.56)
If it’s more than 4 over then count next cell paste sum and continue
If 4 under, do the same.
as of right now, the data goes from rows 1155 to 2481 but this does change as work is completed. I would have to change as needed.
Thanks.

 

[Alex Blakenburg]

Not quite clear on this.
If the running total goes from:
70 to 100 do you want to show 100 because it's closer ?
And from 80 to 110 then 80 because it's closer ?
If that is the case and I always go with closest the +/- 4 is going to be a bit irrelevant.

 

[Bamacoatie]

Not quite clear on this.
If the running total goes from:
70 to 100 do you want to show 100 because it's closer ?
And from 80 to 110 then 80 because it's closer ?
If that is the case and I always go with closest the +/- 4 is going to be a bit irrelevant.

I guess the +\- 4 is somewhat irrelevant.
What I need is for it to be closest to 90. Your example is pretty much what I need.
Sorry for the confusion.
thanks.

 

[Alex Blakenburg]

Give the code below a try.

• For your original testing I have left the starting Row (firstRow) hard coded as 1155
  Once you are comfortable with it you can comment out / remove that line and use uncomment the line
  below it which will use the row of the "Selected Cell".
  It might be worth adding a message box before proceeding or a check that the selected cell is in column P.
  (the later is just to ensure running the macro was intentional - regardless of which column the selected cell is in, it is only the row of that cell that is relevant to the code)
• Note it will work from the row above (firstRow) until the last row used in column P.
  The macro will need to be changed if that is not what you want.
• Column P & R are hard coded
• *** warning *** it will remove existing data in column R for the range of rows that you are running the code against.

Sub GroupBySum()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim arrValues() As Variant
    Dim firstRow As Long
    Dim lastRow As Long
    Dim RowNo As Long
    Dim i As Long
    Dim sumVal As Double
    Dim sumValPrevious As Double
    Dim targetVal As Double
    ' Dim toleranceVal As Long          ' In original requirement no longer used

    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    firstRow = 1155                     ' Example for hard coded option
    'firstRow = ActiveCell.Row
    lastRow = ws.Cells(ws.Rows.Count, "P").End(xlUp).Row

    Set rng = ws.Range("P" & firstRow, "P" & lastRow)
    arrValues = rng.Value
    ' Clear previous results in R - 2 columns to the right of P
    rng.Offset(0, 2).ClearContents
        
    targetVal = 90
    'toleranceVal = 4       'Original requirement no longer used
    RowNo = firstRow
    sumVal = 0
    
    For i = LBound(arrValues) To UBound(arrValues)
        Debug.Print LBound(arrValues), UBound(arrValues)
        sumValPrevious = sumVal
        sumVal = sumVal + arrValues(i, 1)

        ' Test if current sum or next sum is closer to 90
        If sumVal >= targetVal Then
            If (targetVal - sumValPrevious) <= (sumVal - targetVal) Then
                ' Use previous value & set sum to restart from current value
                ws.Range("R" & RowNo - 1) = sumValPrevious
                sumVal = arrValues(i, 1)
            Else
                ' Use current value and reset sum to zero
                ws.Range("R" & RowNo) = sumVal
                sumVal = 0
                
            End If
            
        End If
            
        RowNo = RowNo + 1
    Next i

End Sub

 

[Bamacoatie]

Give the code below a try.

• For your original testing I have left the starting Row (firstRow) hard coded as 1155
  Once you are comfortable with it you can comment out / remove that line and use uncomment the line
  below it which will use the row of the "Selected Cell".
  It might be worth adding a message box before proceeding or a check that the selected cell is in column P.
  (the later is just to ensure running the macro was intentional - regardless of which column the selected cell is in, it is only the row of that cell that is relevant to the code)
• Note it will work from the row above (firstRow) until the last row used in column P.
  The macro will need to be changed if that is not what you want.
• Column P & R are hard coded
• *** warning *** it will remove existing data in column R for the range of rows that you are running the code against.

Sub GroupBySum()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim arrValues() As Variant
    Dim firstRow As Long
    Dim lastRow As Long
    Dim RowNo As Long
    Dim i As Long
    Dim sumVal As Double
    Dim sumValPrevious As Double
    Dim targetVal As Double
    ' Dim toleranceVal As Long          ' In original requirement no longer used

    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    firstRow = 1155                     ' Example for hard coded option
    'firstRow = ActiveCell.Row
    lastRow = ws.Cells(ws.Rows.Count, "P").End(xlUp).Row

    Set rng = ws.Range("P" & firstRow, "P" & lastRow)
    arrValues = rng.Value
    ' Clear previous results in R - 2 columns to the right of P
    rng.Offset(0, 2).ClearContents
       
    targetVal = 90
    'toleranceVal = 4       'Original requirement no longer used
    RowNo = firstRow
    sumVal = 0
   
    For i = LBound(arrValues) To UBound(arrValues)
        Debug.Print LBound(arrValues), UBound(arrValues)
        sumValPrevious = sumVal
        sumVal = sumVal + arrValues(i, 1)

        ' Test if current sum or next sum is closer to 90
        If sumVal >= targetVal Then
            If (targetVal - sumValPrevious) <= (sumVal - targetVal) Then
                ' Use previous value & set sum to restart from current value
                ws.Range("R" & RowNo - 1) = sumValPrevious
                sumVal = arrValues(i, 1)
            Else
                ' Use current value and reset sum to zero
                ws.Range("R" & RowNo) = sumVal
                sumVal = 0
               
            End If
           
        End If
           
        RowNo = RowNo + 1
    Next i

End Sub

This works great.

I actually did build in a msg box for the first row as you suggested.
the first row changes everyday so that was a good idea.

Thank you for your help. I really appreciate it.

 

[Alex Blakenburg]

Thanks for letting me know. Happy to help.
Glad you were able to enhance it further.

You might want to consider an input box so you can vary the amount (targetVal)