add the same number until it exceeds another and return that number vba

[Sotos13]

Hello everyone

I'm new in vba and try to figure out some stuff. I have a two columns in excel and i want to compare each number , for example A1 with B1. A2 with B2 etc..
If A1 is smaller than B1 return in cell C1 the B1. If not add the number in B1 as many times until it is bigger than A1.

[TABLE="width: 192"]
<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl66, width: 64, align: right"]1[/TD]
[TD="class: xl65, width: 64, align: right"]8[/TD]
[TD="width: 64, align: right"]10[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]2[/TD]
[TD="class: xl65, align: right"]45[/TD]
[TD="align: right"]25[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]3[/TD]
[TD="class: xl65, align: right"]14[/TD]
[TD="align: right"]4[/TD]
[/TR]
</tbody>[/TABLE]
in line 1 the answer is 8<10 = 10, line 2 the answer is 25+25 = 50,line 3 the answer is 4+4+4+4 = 16.

So i started like this but i cant figure out how to proceed..
Dim qAnswer As Integer
qAnswer = 2
If Cells(qAnswer, 1).Value < Cells(qAnswer, 2).Value And Not IsEmpty(Cells(qAnswer, 1).Value) Then
Cells(qAnswer, 3) = Cells(qAnswer, 2).Value
Else

Any suggestions?
Thanks

 

[Scott T]

try

Sub sotos()
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row 'find last row in column A
For x = 1 To lr 'loop though rows
    If Cells(x, 1) < Cells(x, 2) Then
        Cells(x, 3) = Cells(x, 2)
    Else
        'loop until colum B is > column A
        i = Cells(x, 2)
        Do Until i > Cells(x, 1)
            i = i + Cells(x, 2)
        Loop
        Cells(x, 3) = i
    End If
Next x

End Sub

 

[Misca]

Welcome to the message board!

Here's how I'd solve this:

Sub MultiplyValues()

Dim c As Range
Dim Rng As Range


With ActiveSheet
'Set the range to calculate:
    Set Rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    
    For Each c In Rng
        With c
'Makes sure the number to be multiplied is greater than 0:
            If .Offset(, 1).Value < 0 Then
 
                .Offset(, 2).Value = Application.WorksheetFunction.RoundUp(.Value / .Offset(, 1).Value, 0) * .Offset(, 1).Value
            
            End If
        End With
    Next c
    
End With


End Sub

My code skips a couple of corners but should return the desired output as long as the second number is an integer greater than 0.

 

[Misca]

Noticed a tiny bug in my code: I used "smalled than" instead of "greater than"

Also came to think that my code will not work correctly with negative numbers and decimals.

 

[Sotos13]

Hi all
thanks for the quick response.
the thing is that Scott's code makes excel not responding and Misca doesn't do anything. I change it to > but no luck.
By reading your Scott it makes sense but it doesnt seem to work.

 

[Scott T]

Do you have blanks in column B or negative numbers? If so how should the be handled?

 

[Sotos13]

if i split the code, the first part works fine (see below) but with all the code it doesnt respond. Does it get into an endless loop?
Dim lr As Long
Dim i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row 'find last row in column A
For x = 1 To lr 'loop though rows
If Cells(x, 1) < Cells(x, 2) Then
Cells(x, 3) = Cells(x, 2)

End If
Next x

[TABLE="width: 192"]
<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]aaa[/TD]
[TD="class: xl65, width: 64"]bbb[/TD]
[TD="class: xl65, width: 64"]ccc[/TD]
[/TR]
[TR]
[TD="class: xl66"]8[/TD]
[TD="class: xl67"]10[/TD]
[TD="class: xl67"]10[/TD]
[/TR]
[TR]
[TD="class: xl66"]45[/TD]
[TD="class: xl67"]25[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]14[/TD]
[TD="class: xl67"]8[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]34[/TD]
[TD="class: xl67"]2[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]16[/TD]
[TD="class: xl67"]12[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]25[/TD]
[TD="class: xl67"]16[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]22[/TD]
[TD="class: xl67"]10[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]36[/TD]
[TD="class: xl67"]4[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]6[/TD]
[TD="class: xl67"]12[/TD]
[TD="class: xl67"]12[/TD]
[/TR]
[TR]
[TD="class: xl66"]48[/TD]
[TD="class: xl67"]8[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]50[/TD]
[TD="class: xl67"]2[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]10[/TD]
[TD="class: xl67"]8[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]20[/TD]
[TD="class: xl67"]10[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]11[/TD]
[TD="class: xl67"]6[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]48[/TD]
[TD="class: xl67"]10[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]16[/TD]
[TD="class: xl67"]5[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]17[/TD]
[TD="class: xl67"]8[/TD]
[TD="class: xl67"][/TD]
[/TR]
[TR]
[TD="class: xl66"]7[/TD]
[TD="class: xl67"]18[/TD]
[TD="class: xl67"]18[/TD]
[/TR]
</tbody>[/TABLE]

 

[Sotos13]

if i split your code Scott, it works great. but by adding the second part (Else loop until colum B is > column A) it doesnt respond.
it's like an endless loop or not?
No i dont have blank or negative.

 

[Scott T]

The code works for me. How many rows do you have? The more rows the longer it will take. When I have 77826 rows then it briefly says not responding while the code runs but it does run.

 

[Misca]

If this your table it looks like your numbers are formatted as text.

The code in my macro checks the value is greater than zero. The value of text is always zero. Try this instead:

Sub MultiplyValues()

Dim c As Range
Dim Rng As Range




With ActiveSheet
'Set the range to calculate:
    Set Rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    
    For Each c In Rng
        With c
'Makes sure the number to be multiplied is greater than 0:
            If --.Offset(, 1).Value > 0 Then
 
                .Offset(, 2).Value = Application.WorksheetFunction.RoundUp(.Value / .Offset(, 1).Value, 0) * .Offset(, 1).Value
            
            End If
        End With
    Next c
    
End With




End Sub