Problems with Loop - excel

I am trying to solve an issue..
On a column, I have some stock numbers (activecell). And I have one Sales number.
I have to subtract this Sales Number for the stock numbers until it's a 0. As an example:
Sales Number = 500
Result = 500 - StockNumber1
Result2 = Result - StockNumber2
Result3 = Result - StockNumber3
I am trying to figure out a way to do it in a loop.
Maybe something like:
i = 0
Do While SalesNumber > Activecell.Offset(i,0)
SalesNumber - ActiveCell(i,0)
i = i + 1
Loop
However, I have not found a solution yet.. There are like 3 stock numbers, usually.
How can I do to stop the loop when the stock numbers are over? Does anyone have an idea?
I dont know I am clear enough.. Any doubts, please ask!
Thanks for any help!

This?
Dim i, SalesNumber, nRowMax
nRowMax = Rows.Count
SalesNumber = 500
' my stock number starts at the cell A1:
i = 1
Do While SalesNumber > 0
' use this to avoid infinite loop:
If (i > nRowMax) Then
Exit Do
ElseIf (IsEmpty(Cells(i, 1))) Then
Exit Do
End If
SalesNumber = SalesNumber - Cells(i, 1)
i = i + 1
Loop

Related

How to write basic macro to compare two columns for a difference within .50?

I'm trying to write a macro that compares the differences between values in columns B and C. I'd like the macro to compare the two columns (B & C) and find depths that are within +/- .50 of each other, and I'd like to keep track of the sample # (column A) that corresponds to the sample depth that is within +/- .50 of the test depth, and then to find the difference between the sample depth and test depth. For example, the following images are before and after what I'd like the macro to look like:
Before:
After:
here you go. nested loop for the read, iterator to count the output row. May need some customization, but this is the core of it.
Sub foo()
Dim itr As Integer
itr = 2
For Each sd In Range("B:B")
If sd.Value = "" Then Exit For
If IsNumeric(sd.Value) Then
For Each td In Range("C:C")
If td.Value = "" Then Exit For
If IsNumeric(td.Value) Then
If Abs(sd.Value - td.Value) < 0.5 Then
Cells(itr, 5) = sd.Value
Cells(itr, 6) = td.Value
Cells(itr, 8) = sd.Value - td.Value
itr = itr + 1
End If
End If
Next td
End If
Next sd
End Sub

How to group datas in specific condition and how to get minimum data in it

Having a problem with making a code in vba. First, there are numbers and datas on each row d and e, like number 1~14, 20~39, 48~60 and 84~98. These groups change each time(Randomly). What I want to get is a minimum value of each group. This value should be next to the rows with data. Could you help me with this one?
Rowsss = .Cells(Rows.Count, 4).End(3).Row
For i = 10 To Rowsss + 1
If .Cells(i, 4) - .Cells(i - 1, 4) = 1 Then
n = n + 1
next i
if .cells(i,4)-.cells(i-1,4)<>1 then
(I'm stuck in here)
End If
Next
I want to get results like group number and results
ex. 1/14/minimum value

Custom Rounding Function in Excel

Let's say you have a formula that produced the following numbers:
50.77%
24.62%
24.62%
Added together they equal 100%, however they do not want the decimal places shown, and the number still visually showing they equal 100%. If you take the decimal places out you get 51% 25% 25% which actually equal 101%.
They suggested that I put some type of formula that will round the largest decimal place up.. ie... 50.77% becomes 51%, and round the others down... if it goes over 100%, if it is still not equal to 100%, round up the next largest number until and so on until the total does equal 100%.
Anyone know what type of formula of vba coding that I could use for this?
I do not even know where to start.
You can use helper columns with this formula:
=IF(SUM($B$1:B1)+ROUND(A2,2)>1,1-SUM($B$1:B1),ROUND(A2,2))
Unless I'm missing something, you can do: =TEXT(SUM(A1:A3),"##"), assuming your numbers are in A1:A3.
What I usually do in cases like this is to set a formula at the last number (e.g. A4) like this one :
=1-(SUM(A1:A3))
Edit:
This is what I do, if I have to use vba:
Calculate the whole range. Round each number as you wish.
See the difference which you should add or substract (e.g. if you get the sum
to 99.9%, then your difference is 0.01).
Add this difference to the last number in the range. Via VBA.
Even if it is negative, (e.g. if you have a sum of 100.01) then you should sum with a negative number, thus anything is ok.
The only I can think of is "cheating" in a really nasty way... assuming that you have formulas, which do the calculation, a replacement is not possible... So I simply change the formatting (and keep the old values) like this:
Private Sub recalc_percs()
Dim RangeToCheck As Range
Set RangeToCheck = Range("A5:A9") 'designet to work with a range containing only 1 area and 1 column
Dim x(1) As Variant, i As Long, b(2) As Double
RangeToCheck.NumberFormat = "0%"
x(0) = Evaluate(RangeToCheck.Address & "*100")
x(1) = Evaluate("INDEX(ROUND(" & RangeToCheck.Address & "*100,0),)")
While Application.Sum(x(1)) <> 100 And Abs(100 - Application.Sum(x(1))) < 4 'the <4 is for deleting or whatever to not loop endless times
For i = 1 To RangeToCheck.Rows.Count 'get highest and lowest difference
b(0) = x(1)(i, 1) - x(0)(i, 1)
If b(0) < b(1) Then b(1) = b(0)
If b(0) > b(2) Then b(2) = b(0)
Next
If Application.Sum(x(1)) < 100 Then b(0) = b(1) Else b(0) = b(2)
For i = 1 To RangeToCheck.Rows.Count
If b(0) = x(1)(i, 1) - x(0)(i, 1) Then
x(1)(i, 1) = x(1)(i, 1) + (0.5 + (b(0) > 0)) * 2
Exit For
End If
Next
Wend
For i = 1 To RangeToCheck.Rows.Count
If Application.Round(x(0)(i, 1), 0) <> x(1)(i, 1) Then
RangeToCheck.Cells(i).NumberFormat = """" & x(1)(i, 1) & "%"""
End If
Next
End Sub
It may need to change some parts... but basically it is working. Also it is not looking very well, but I am in a hurry right now... sorry.
If you have any questions, just ask... I'll reply as soon as possible ;)

Error in value when assigne variable with cells value

Dim PtDnr As Single
Dim TxDnr As Single
GrsDnr AsDim Single
Dim AmntDnr As Single
Dim Jour As Integer
Dim I As Integer
Jour = 7
PtDnr = 2256.03 'trhough 2 loops, the amount is correct
PtDnr = 0
For I = 35 To 40
PtDnr = PtDnr + Sheets(1).Cells(Jour, I)
Next
For I = 47 To 54
PtDnr = PtDnr + Sheets(1).Cells(Jour, I)
Next
TxDnr = Sheets(1).Cells(Jour, 32) ' This Cell has a Value of 167.11 "
NtDnr = Sheets(1).Cells(Jour, 33) ' This Cell Has a value of 2088.92
GrsDnr = TxDnr + NtDnr ' Give me 2256.03, this amount is correct
AmntDnr = GrsDnr - PtDnr ' Give me 2.441406E.04 wich is wrong
I checked the Cells one by one and make them with 12 decimals, after the first 2, all are at "0" ex: 167.110000000000
What I do wrong, I pass all night and tried several possibility but cannot figure out.
Thank you for your help
Jean
Try using data type Double instead of Single.
Although I don't understand how anyone is expected to know what is going wrong if we can not see the values that are getting fed into these calculations.

Combination Generator yet keep in order

Wondering if anyone could help me. I'm stumped. It's been ages since I used excel....
I have 9 columns with different values in each cell, different numbers of cells per column.
I need a formula/macro to spit out all combinations of the cells and yet still remain in the exact same order of the columns.
For example
Columns:
D / 003 / 23 / 3 / 3R / C / VFX
... / 005 / 48 / 3 / 12 / .. / VDF
... / 007 / ... / 1 / ... /... / HSF
And it spits out like this:
D0032333RCVFX
D0032333RCVDF
D0032333RCHSF
D0034833RCVFX
D0034833RCVDF
and so on....
and so on.....
Presumably you will want to call this function with a "serial number" - so that you can call "the Nth combination". The problem then breaks into two parts:
Part 1: figure out, for a given "serial number", which element of each column you need. If you had the same number of elements E in each column it would be simple: it's like writing N in base E. When the number of elements in each column is different, it's a little bit trickier - something like this:
Option Base 1
Option Explicit
Function combinationNo(r As Range, serialNumber As Integer)
' find the number of entries in each column in range r
' and pick the Nth combination - where serialNumber = 0
' gives the top row
' assumes not all columns are same length
' but are filled starting with the first row
Dim ePerRow()
Dim columnIndex As Integer
Dim totalElements As Integer
Dim i, col
Dim tempString As String
ReDim ePerRow(r.Columns.Count)
totalElements = 1
i = 0
For Each col In r.Columns
i = i + 1
ePerRow(i) = Application.WorksheetFunction.CountA(col)
totalElements = totalElements * ePerRow(i)
Next
If serialNumber >= totalElements Then
combinationNo = "Serial number too large"
Exit Function
End If
tempString = ""
For i = 1 To UBound(ePerRow)
totalElements = totalElements / ePerRow(i)
columnIndex = Int(serialNumber / totalElements)
tempString = tempString & r.Cells(columnIndex + 1, i).Value
serialNumber = serialNumber - columnIndex * totalElements
Next i
combinationNo = tempString
End Function
You call this function with the range where your columns are, and a serial number (starting at 0 for "top row only"). It assumes that any blank space is at the bottom of each column. Otherwise, it will return a string that is the concatenation of combinations of values in each column, just as you described.
EDIT perhaps the following picture, which shows how this is used and what it actually does, helps. Note that the first reference (to the table of columns of different length) is an absolute reference (using the $ sign, so when you copy it from one cell to another, it keeps referring to the same range) while the second parameter is relative (so it points to 0, 1, 2, 3 etc in turn).

Resources