Simultaneous while decrement (yep I searched)

[RandyJseatac]

We have about 200 rows of data. Each row is a day.
Column A values come from other formulas on that row.
Column A values range from 0 to 20
Each new entry in column A contributes "1" to the total in column B for each row until it (A) has decremented to 0.
Each entry in column A should decline by one on each of the rows that follow (each passing day)
Yep, the A's overlap sometimes.

An example may illustrate better:
Column B is the correct answer (manually). My question is how do I program that?
Column B is a running total of how many Simultaneous A's are currently "active" on that particular day (row)

Thanks for any help! It's been a head-scratcher for days.

3 1
3 2
3 3
0 2
0 1
0 0
9 1
0 1
2* 2
0 2
4 2 <- on this row, the 4 adds one, the 2* gets to zero, and the 9 has 5 rows left before it is zero
0 2
1 3

Note: the results do not need to be on the same rows as the data. Bottom line is that I'm looking for the maximum simultaneous A's. -- "3" in this case

 

[craig.penny]

This should do what you need. It assumes your data starts in the first row, the inputs are in column a, and your output will be in column B. You will need to change the variable SetSize to the number of rows you need to read in. I should point out that this is probably not a smart way to do it, I just happen to like using multi-dimensional matrices

Sub ABC()
Const SetSize As Integer = 13
Dim Mat(1 To SetSize, 1 To SetSize) As Integer
Dim i As Integer, j As Integer, k As Integer
For i = 1 To SetSize
      For j = 1 To WorksheetFunction.Min(Cells(i, 1), SetSize - i + 1)
            Mat(i + j - 1, i) = 1
      Next j
Next i
For i = 1 To SetSize
      k = 0
      For j = 1 To SetSize
            If Mat(i, j) > 0 Then k = k + 1
      Next j
      Cells(i, 2) = k
Next i
End Sub

 

[RandyJseatac]

craig.penny thanks for the VBA code. It works great! Thank you!


I failed to mention that this macro needs to run at every recalc.
or some other way to get it to work every time Solver puts in new numbers


I tried wrapping your code in a Worksheet_Change macro, but I don't know what I'm doing and it wouldn't even run once.

 

[Peter_SSs]

Column A values come from other formulas on that row.

.. this macro needs to run .. every time Solver puts in new numbers

Welcome to the MrExcel board!

I have an idea to do this and for a more efficient way to produce the column B values.

However, I would want to know more about your sheet and its layout and in particular the formulas that drive the values into column A. The reason is that you have used whole numbers in your sample data but Solver regularly produces decimal values which may still be held in the background even though whole numbers may be showing on your sheet. Such a situation would influence the code I am contemplating.

 

[RandyJseatac]

Peter,

thanks for considering doing this challenge!


I know what you mean about Evolutionary Solver using decimal values. Sometimes it's buggy and shows them even though I have set all the input cells' Constraints to Integer. Rest assured, there are many layers of formulas between Solver's input and the "Column A" in the example.


The formula that produces A is

=IF(I12,IF(P12,22,IF(Q12=TRUE,M12+1,O12)),0)


The formula that produces M and O are thus:

=IF(ISNA(N12),999,N12)


The formula that produces N is:


{=MATCH(TRUE,C13:C33>J12,0)}


so we're getting either "0" or a whole number generated by Match doing it's counting on fingers and toes.

 

[Peter_SSs]

Some more questions then ..

1. Can you confirm that it is still column A that we are using to produce the increment/decrement values you originally asked for?

2. Do the values start in row 1? If not, where?

3. Do the results still go in column B? If not, where?

4. Which columns/ranges/cells does the Solver change? Hopefully that information can be used to trigger the code only when required.

 

[RandyJseatac]

Why certainly!


Decrementing additions column is actually AA
Output column is actually AC
Starting with Row 12
Solver changes the range G5:K5

 

[Peter_SSs]

Try this in a copy of your workbook.

To implement ..

1. Right click the sheet name tab and choose "View Code".

2. Copy and Paste the first code below into the main right hand pane that opens at step 1.

3. In a standard Module Paste the second code below.

4. In your sheet, run the Solver.

<font face=Courier New><br><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Intersect(Target, Range("G5:K5")) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        Decrement<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>


<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Decrement()<br>    <SPAN style="color:#00007F">Dim</SPAN> a, b<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Const</SPAN> fr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 12 <SPAN style="color:#007F00">'<-- First row</SPAN><br>    <br>    lr = Range("AA" & Rows.Count).End(xlUp).Row<br>    rws = lr - fr + 1<br>    <SPAN style="color:#00007F">ReDim</SPAN> b(1 <SPAN style="color:#00007F">To</SPAN> rws, 1 <SPAN style="color:#00007F">To</SPAN> 1) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Range("AA" & fr).Resize(rws)<br>        a = .Value<br>        <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> rws<br>            <SPAN style="color:#00007F">If</SPAN> a(i, 1) > 0 <SPAN style="color:#00007F">Then</SPAN><br>                j = 0<br>                <SPAN style="color:#00007F">Do</SPAN><br>                    b(i + j, 1) = b(i + j, 1) + 1<br>                    j = j + 1<br>                <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> j < a(i, 1) And i + j <= rws<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> i<br>        Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>        .Offset(, 2).Value = b<br>        Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>

 

[RandyJseatac]

Looks like the code works right when entering data manually in cells G5:K5

Nice!

But when using Evolutionary Solver, get a Runtime err 13.
Click Debug, it highlights the If statement:
With Range("AA" & fr).Resize(rws)
a = .Value
For i = 1 To rws
If a(i, 1) > 0 Then

 

[RandyJseatac]

Error 13 is VBA - "Type Mismatch"

This only happens if I include a result of the VBA output in the Solver Constraints

specifically: AC8 =MAX(AC12:AC200)
<br>
and in Evolutionary Solver, setting AC8 with a constraint of <=5