Subtract Amount From Cell Until It Reaches 0 multiple reminding amount - excel

My formula below subtracts a cell until it reaches zero, and moves to the next one. The subtraction is based on the value “B”. Each time the formula comes across the value “B”, this action is performed.
Question: I have been trying to advance this to formulae, in that each time “B” is found that cell is minuses until zero and those amount multiple by the adjacent price.
could you please provide me with a formula which does this ?
Example: when it comes across the first B the full value of 100 x 10 will be multiplied and the reminder 50 will be multiplied by 15 i.e. 50 x 15 price of the next A. These values will be summed.
=MAX(SUMIF($A$2:A2,"A",$B$2:B2)-SUMIF($A$2:$A$10,"B",$B$2:$B$10),0)
The reminder of the 50 is coming from the difference between the B 150 - A 100 , which leaves 50 to be still absorbed .
Further Calculation for explanation:
Apologies thats meant to say calculation of 6000

Your question is still very unclear. What does "My formula below subtracts a cell until it reaches zero" mean? Also, as OldUgly pointed out, it seems that you are ignoring the second A. Since we can't understand each other, take a look at the code below and try to rewrite it yourself to fit your needs. It assumes the data is in a sheet named "Data", and that there is a button (Button1) to run the code.
Dim lLastRow As Long
Dim i As Integer
Dim QtyNumberA, QtyNumberB, QtyNumberRem As Integer
Sub Button1_Click()
lLastRow = Worksheets("Data").Cells(2, 1).End(xlDown).Row 'Rows with data, starting 2nd row (titles in the first)
QtyNumberA = 0 'Variable for storing quantities of A
QtyNumberB = 0 'Variable for storing quantities of B
QtyNumberRem = 0 'Variable for storing quantities remaining
For i = 2 To lLastRow 'scan all rows with data
If (Worksheets("Data").Cells(i, 1).Value = "A") Then
QtyNumberA = QtyNumberA + Worksheets("Data").Cells(i, 2).Value
ElseIf (Worksheets("Data").Cells(i, 1).Value = "B") Then
QtyNumberB = QtyNumberB + Worksheets("Data").Cells(i, 2).Value
QtyNumberRem = QtyNumberA - QtyNumberB
Worksheets("Data").Cells(i, 6) = QtyNumberRem
End If
Next
End Sub

Related

VBA Code to add first 10 even numbers regardless of number of inputs in a column

I ran into a problem when I try to add the first 10 even numbers in a column regardless of the number of inputs someone has entered into said column.
The issue occurs when there are less than 10 inputs (in my case 7) and I have tried to break the loop if there are no more numbers after the last one but it doesn't seem to work as it crashes Excel; most probably because it loops infinitely.
The original code was fine until I entered below 10 even numbers. When I did it would loop infinitely and crash so I inputted a forceful break in the code (hence the Count=999) but it does not seem to work
Sub TenPosInt()
Dim Total As Integer, size As Integer, myRange As range
Dim Count As Integer
Count = 1
Set myRange = range("W:W")
size = WorksheetFunction.CountA(myRange)
While Count <= 10
If IsEmpty(Cells(Count, "W")) Then
Count = 999
End If
If Cells(Count, "W").Value Mod 2 = 0 Then
Total = Total + Cells(Count, "W").Value
Count = Count + 1
End If
Wend
MsgBox Total
End Sub
My Inputs are currently 2,4,6,5,2,4,6,8,1,3,5 so it does not meet the 10 even integers, however I still want it to run regardless (hence the Count=999 line). The correct return should be 32.
A Do-While/Until loop is recommended instead of While-Wend (see this).*
Here I use a separate counter for row and the number of even values (and stole David's idea of combining the two conditions in the Do line).
Sub TenPosInt()
Dim Total As Long, r As Long, Count As Long
r = 1
Do Until Count = 10 Or Cells(r, "W") = vbNullString
If Cells(r, "W").Value Mod 2 = 0 Then
Total = Total + Cells(r, "W").Value
Count = Count + 1
End If
r = r + 1
Loop
MsgBox Total & " (" & Count & " even numbers)"
End Sub
*Actually I would be more inclined to use one of the other gent's answers, but I have tried to stick as close to yours as possible. (Also a good idea to check a cell is numeric before checking for even-ness.)
Just for fun - here is an approach that uses a For...Next loop, allows for non-numeric entries in Column W, and handles the possibility of blank rows between entries.
Sub TenPosInt()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "W").End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
If Not IsEmpty(Cells(i, "W")) Then
If IsNumeric(Cells(i, "W")) Then
If Cells(i, "W").Value Mod 2 = 0 Then
Dim counter As Long
counter = counter + 1
Dim total As Long
total = total + Cells(i, "W").Value
If counter = 10 Then Exit For
End If
End If
End If
Next
MsgBox total
End Sub
Why not use a standard for loop across a range? this would give more specific inputs for the subroutine.
Description of what is occuring below has been commented out to allow for copy/pasting more easily.
'Define your range (you use columns("W"), but narrow that)... assuming you start in row 2 (assumes row 1 is headers), move to the last row, of the same columns:
lr = cells(rows.count,"W").end(xlup).row
'so you know the last row, loop through the rows:
for i = 2 to lr
'Now you will be doing your assessment for each cell in column "W"
if isnumeric(cells(i,"W").value) AND cells(i,"W").value mod 2 = 0 then
s = s + cells(i,"W").value
counter = counter + 1
if counter = 10 then exit for
end if
'Do that for each i, so close the loop
next i
'You now have determined a total of 10 items in the range and have added your items. Print it:
debug.print s
Edit1: got a comment to not break-up the code in an explanatory fashion, so I have added ' to comment out my explanations in an effort to make my coding portion copy/pasteable as a lump.

Excel macro - add one column to another

Hi I have a Excel worksheet with data like this:
VISIT <48 >48 TOTAL BILLED NOT BILLED
10 4 3 7 3
I need a macro that will add the not-billed to the <48 i.e. 3+4= 7.
7 would then replace the 4.
I tried C13=C13+F13 but it does not compile.
From your question, I wrote a tested and working macro as requested.
Assuming your Cell columns is the same as in the section below. (Note that the rows may differ and may start on different positions)
You can select the rows that needs to be processed as displayed in the picture.
Sub calculate()
' Calculates for each row in any selection
' Takes value in C and add value in F if value in F is larger than 0 then afterwards makes value in f equal to 0
' Asumes that Column "C" have the "Visit" and Column "F" is the "Not Billed" columns
Dim sel As Range
Dim rw As Range
Dim l As Long
Set sel = Selection
For Each rw In sel ' Adapt this to however you need to specify the selection you want to work with
If (Cells(rw.Row, 6).Value > 0) Then ' Test if the value need to be processed
l = Cells(rw.Row, 3).Value + Cells(rw.Row, 6).Value
Cells(rw.Row, 6).Value = 0
Cells(rw.Row, 3).Value = l
'Cells(rw.Row, 3) would be column C
'Cells(rw.Row, 6) would be column F
End If
Next
End Sub
After running the macro your file will look like:
Let me know if it works for you.

VB Nested Loop w/ Conditionals Syntax

I am new to VB and am having trouble getting a good grasp on the syntax of nested loops. For example:
For N = 8 To 22
For M = 4 To 19
If Cells(N, 3).Value >= 0 Then
Cells(M, 35).Value = 1
Else
Cells(M, 35).Value = 2
End If
Next M
Next N
I want this loop to check one column of cells and IF a cell contains a 0 or positive number it should return "1" in the other specified column. Otherwise, it should return a "2".
Unfortunately this loop currently is returning (ELSE) "2" in every cell of the new column. Any explanation of what I am doing wrong?
Nested loops like this operate by repeating the inner cycle from start to finish every time the outer cycle goes through one step. So for each N, every row M will have its cell in column 35 set to 1 or 2 (all the same) based on the value at row N and column 3. So in this case, the last row N must have a negative number or be missing, which sets every one of the output column cells to "2".
What I suspect you want is something more like this:
For N = 8 To 22
If Cells(N, 3) >= 0 Then
Cells(N - 4, 35) = 1
Else
Cells(N - 4, 35) = 2
End If
Next N
Note that there seems to be an off-by-one error in your original code as well, in that N goes over 15 rows, but M goes over 16 rows. Also, because .Value is the default property, you can leave it out.
Bonus: Generally speaking, you'll want something with fewer magic numbers, like this:
Option Explicit
Public Sub DoSomething()
Const ColTest As Integer = 3, ColResult As Integer = 35, DRowResult As Integer = -4
Const RowStart As Integer = 8, RowEnd As Integer = 22
Dim Row As Integer
For Row = RowStart To RowEnd
If Cells(Row, ColTest) >= 0 Then
Cells(Row + DRowResult, ColResult) = 1
Else
Cells(Row + DRowResult, ColResult) = 2
End If
Next Row
End Sub
Then, if you need to generalize it to work on different areas (by switching the constants to parameters), change where you've hardcoded it to work, or whatever else, it's simple to fix it at the top, once, and be sure you've got everything. It's also easier to understand in many cases. And, of course, Option Explicit is just good in general. (D in the constant names stands for delta/difference.)

Find next ocurrence of values - COUNTIF is too slow

I'm trying to speed up a COUNTIFS formula in a table I have.
The table is over 60k rows and the COUNTIFS has three conditions. The formula right now looks like this:
=IF(AND(COUNTIFS([Vessel],[#Vessel],[Date],">"&[#Date],[ETA],"<="&[#ETA]+20)=0,[#Arrived]=1,[#Sailed]=1,[#Date]<MAX([Date])),1,0)
The problem is that the calculation takes a very long time and it triggers everytime something change, even the filter. I don't want to turn calculations to manual in this sheet.
The purpose of the formula is to find the next occurence of the vessel in the line, the ETA can be slightly changed from day to day or the same ship can appear months later. I need to confirm if the vessel appears with the same ETA (or up to 20 days of difference) on another day.
Is there any other solution to this problem?
Maybe try building this as a macro instead, that way you would have control over when it executes.
Here is a start on a method for doing this. It gets the job done but breaks on an error on/after the last line is processed. Edit : Fixed and tested
Public Sub shipcheck()
Application.ScreenUpdating = False
Dim x As Long
Dim y As String
Dim counter As Long
For x = 2 To Range("A85536").End(xlUp).Row ' Assuming data has headers
y = Cells(x, 1) ' This assumes your vessel is in the first column
counter = x + 1
Do
If cells(counter,1) = "" Then Exit Do
If y = Cells(counter, 1) Then
If Cells(x, 2) <> Cells(counter, 2) Then 'This assumes your date is the second column
If DateDiff("d", Cells(x, 3), Cells(counter, 3)) > 20 Then ' this assumes ETA is your third column
Cells(x, 4) = 1 'This assumes the positive test is the fourth column
Cells(counter, 4) = 1
Exit Do
Else
End If
Else
End If
Else
End If
counter = counter + 1
Loop
Next x
Application.ScreenUpdating = True
End Sub

Excel macro for changing ID value's

For example:
695678 needs to be 1
695678 needs to be 1
695678 needs to be 1
695678 needs to be 1
695683 needs to be 2
695683 needs to be 2
695683 needs to be 2
696217 needs to be 3
696217 needs to be 3
I got this list of ID's (every number corresponds to a person) However these numbers for example 695678, 695683, 696217 don't go up by one. They are all ranked from low to high. Is there a way to automatically change these values to 1,2,3,... and so on by changing the lowest value to 1 and the second lowest value to 2 and so on. (can't figure out how to do it with macro's)
One note is that the IDs are repeated as these people made more then one transaction.
thanks!
If you require a VBA solution, then:
Sub Renumber()
Dim N As Long, I As Long, OldValue As Long
Dim K As Long
K = 1
N = Cells(Rows.Count, "A").End(xlUp).Row
OldValue = Cells(1, 1).Value
For I = 1 To N
If Cells(I, 1).Value = OldValue Then
Cells(I, 1).Value = K
Else
OldValue = Cells(I, 1).Value
K = K + 1
Cells(I, 1) = K
End If
Next I
End Sub
#Gary's Student, your solution close to perfect, I've looked into this and added a small correction, Compiling it gives an runtime error, your K value is 1 and in your else clause it just takes the same value again.
After adjusting it to their excel file it worked perfect:
Sub Renumber()
Dim N As Long, I As Long, OldValue As Long
Dim K As Long
K = 1
N = Cells(Rows.Count, 2).End(xlUp).Row
OldValue = Cells(2, 2).Value
For I = 2 To N
If Cells(I, 2).Value = OldValue Then
Cells(I, 2).Value = K
Else
OldValue = Cells(**I + 1**, 2).Value
K = K + 1
Cells(I, 2) = K
End If
Next I
End Sub
The I + 1 between ** is the part that bugged.
I've also changed the cell indexes accordingly.
Kind regards,
David
Please try:
=IF(ISBLANK(A1),1,IF(A1=A2,B1,B1+1))
copied down to suit (with a blank in the top row of data).
To try to clarify, assumes data is in ColumnA but starting in A2 (A1 and B1 being blank), that the formula above is placed in B2 and copied down to suit.
First the test is whether A1 is blank (if True, returns 1 the start point - though this could be keyed into B2 and a simpler formula then used in B3 and so on). If A1 is not blank then there is a further test, whether or not the value has changed. If it has not (True), then use the value immediately above, if it has changed (False) use the value immediately above incremented by one.
Another formula incase your data ever needs to be unsorted, and should be faster then any Macros:
=SUMPRODUCT( (FREQUENCY($A$1:$A$9, $A$1:$A$9) > 0) * (A1 >= $A$1:$A$10) )

Resources