Finding a number with 2 decimal places

[shah0101]

Hi Experts,

I have a value in C10 (say 37,313.58) which is fixed.

In B10 & B11 are Prices which can be changed
In A10 is A11 Quantity which can be changed

I need a formula / vba script to get exact two decimal place number (not rounded, not truncated) in:
(1) "B10" (range from 0.84 to 6.00) wholly divisible by "C10" by "A10"
(2) "B11" (range from 12.00 to 30.00) wholly divisible by "C11 by A11"


How we can find an exact two decimal places number by automatically change the number either in B10/B11 or A10/A11 to get the final number as in C10 (which is basically A10 * B10 or A11 * B11).


I don't know if I am making any sense! so uploaded a picture.

 

[shah0101]

So Quantity could be whole number or 1- 2 decimal?
Is it:
1st priority: whole number
2nd: from 1 to 2 decimal
?

Yes, please.
first priority: whole number
second priority: 1 to 2 decimals

 

[bebo021999]

With C10 contants giving value
From A13:F13 downward will be list of Qty & Price for 3 cases: whole qty, 1 decimal and 1-2 decimal

Option Explicit
Sub test()
Dim i&, k&, arr()
Dim StartP As Double, MaxP As Double, Value As Double, Sp As Double, NewP  As Double, NewQ  As Double
Value = Range("c10").Value
StartP = 0.84'Start Price
MaxP = 6 ' Max Price
Sp = 0.01 ' Step Price
ReDim arr(1 To 200000, 1 To 6)
    Do
        i = i + 1
        NewP = StartP + (i - 1) * 0.01
        NewQ = Value / NewP
        If Int(NewQ * 100) = NewQ * 100 Then
            k = k + 1
            arr(k, 5) = NewQ: arr(k, 6) = NewP
            If Int(NewQ * 10) = NewQ * 10 Then
               arr(k, 3) = NewQ: arr(k, 4) = NewP
               If Int(NewQ) = NewQ Then
                    arr(k, 1) = NewQ: arr(k, 2) = NewP
               End If
            End If
        End If
    Loop Until NewP > MaxP
Range("A13").Resize(200000, 6).ClearContents
Range("A13").Resize(k, 6).Value = arr
End Sub

 

[shah0101]

With C10 contants giving value
From A13:F13 downward will be list of Qty & Price for 3 cases: whole qty, 1 decimal and 1-2 decimal

Option Explicit
Sub test()
Dim i&, k&, arr()
Dim StartP As Double, MaxP As Double, Value As Double, Sp As Double, NewP  As Double, NewQ  As Double
Value = Range("c10").Value
StartP = 0.84'Start Price
MaxP = 6 ' Max Price
Sp = 0.01 ' Step Price
ReDim arr(1 To 200000, 1 To 6)
    Do
        i = i + 1
        NewP = StartP + (i - 1) * 0.01
        NewQ = Value / NewP
        If Int(NewQ * 100) = NewQ * 100 Then
            k = k + 1
            arr(k, 5) = NewQ: arr(k, 6) = NewP
            If Int(NewQ * 10) = NewQ * 10 Then
               arr(k, 3) = NewQ: arr(k, 4) = NewP
               If Int(NewQ) = NewQ Then
                    arr(k, 1) = NewQ: arr(k, 2) = NewP
               End If
            End If
        End If
    Loop Until NewP > MaxP
Range("A13").Resize(200000, 6).ClearContents
Range("A13").Resize(k, 6).Value = arr
End Sub

View attachment 65005

Thank you very much for your time and efforts to help.

I think I am doing something wrong because after executing the macro, it doesn't bring any results. Sharing screenshots. I just changed the name to "PriceCalc".

Please advise.

 

[bebo021999]

It works for me.
Maybe, try to change value in C10?

 

[mikerickson]

Multiply everything by 100 and look for integers instead of "exact two decimal places"

 

[shah0101]

It works for me.
Maybe, try to change value in C10?

View attachment 65099

Thank you so very much..