CODEWITHSUNDEEP
excelvbafor-loopsum
CosmoCramer
CosmoCramer

Reputation: 63

Sum values until a certain value is reached and then start with the next column

I have to sum some values until it has reached a full number (1.0 or 2.0 or 3.0) in Excel VBA.

I have contracts and the following dataset, since I can simply count only a "full contract" as one, I have to sum it until it reaches this threshold. When its over that threshold, lets say I have 0.5 contracts and I get 0.6 in the next month, I generate a full contract and keep 0.1 ((0.5+0.6) -1) as the next base to start the sum for the next month. But if I reach more than 2, I have to get 2 contracts in the last column.

I you understand my problem

I thought about something like a For loop that sums the values in the columns and if the sum is >= 1 than it writes "1" into the next column and subtracts 1 from the sum and continues if the sum is >= 2 than it writes "2" into the next column and subtracts 2 from the sum and so on...

Dates   Est. Contracts  Sum of Contracts    Actual Contracts
01.06.2019  0,2               0,2   
01.07.2019  0,3               0,5   
01.08.2019  0,5               1,0                 1
01.09.2019  0,5               0,5   
01.10.2019  0,6               1,1                 1
01.11.2019  0,7               0,8   
01.12.2019  0,9               1,7                 1
01.01.2020  1,2               1,9                 1
01.02.2020  1,5               2,3                 2
01.03.2020  1,7               2,1                 2
01.04.2020  2,0               2,0                 2
01.05.2020  2,2               2,2                 2

Upvotes: 1

Views: 624

Answers (1)

cekar
cekar

Reputation: 366

you mean something like that?:

╔═══════╦═══════════════╦═══════════╦══════════════╗
║ dates ║ est contracts ║ sum contr ║ actual contr ║
╠═══════╬═══════════════╬═══════════╬══════════════╣
║       ║ 0.1           ║ 0.1       ║              ║
║       ║ 0.2           ║ 0.3       ║              ║
║       ║ 0.3           ║ 0.6       ║              ║
║       ║ 0.4           ║ 1         ║            1 ║
║       ║ 0.2           ║ 0.2       ║              ║
║       ║ 0.4           ║ 0.6       ║              ║
║       ║ 0.4           ║ 1         ║            1 ║
║       ║ 0.8           ║ 0.8       ║              ║
║       ║ 1.4           ║ 2.2       ║            2 ║
║       ║ 0.9           ║ 1.1       ║            1 ║
║       ║ 2.2           ║ 2.3       ║            2 ║
╚═══════╩═══════════════╩═══════════╩══════════════╝


Option Explicit

Sub WholeContracts()
Dim rng As Range
Dim lastrow As Long
Dim el As Range
Dim sumContr As Double
lastrow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = Range("B2", "B" & lastrow)
rng.Select

sumContr = 0

For Each el In rng
    el.Select
    sumContr = el.Value + sumContr
    el.Offset(0, 1).Value = sumContr

    If Int(sumContr) = 1 Then
        el.Offset(0, 2) = 1
        sumContr = sumContr - 1
    ElseIf Int(sumContr) = 2 Then
        el.Offset(0, 2) = 2
        sumContr = sumContr - 2
    ElseIf Int(sumContr) = 3 Then
        el.Offset(0, 2) = 3
        sumContr = sumContr - 3
    End If
Next el

End Sub

Upvotes: 1

Related Questions