Nested IF & Do Until Loop | VBA

Question

This code is working fine but it has minor defect. I was hoping to get some help here.

This code needs to compare 2 values and divide the value in equal parts and place it in next cell.

First 2 conditions are working fine. The third condition is working fine but has 2 issues mentioned below which I need help with.

For example if X = 2 and Y = 8, it should divide Y in 4 equal parts as per X value but it is only placing 3 values of 2 in offset cells
Also, if Y = 7 then it should place values as 2 2 2 1 in corresponding cells
While it is doing the work for first cell having Y > X, it is putting incorrect value in farther cell for next Y > X value

Please advise on what needs to be changed.

Sub Calc()
    Dim ws As Worksheet
    Dim i, j, x, y As Variant
    Dim lrow As Long
    lrow = Worksheets("AB").Cells(Rows.Count, 1).End(xlUp).Row
    Set ws = Workbooks("BC.xlsm").Worksheets("AB")
    j = 9

    With ws
        .Activate
        For i = 2 To lrow
            x = Cells(i, 7).Value
            y = Cells(i, 8).Value
            If y < 0 Then
                Cells(i, 8).Offset(0, 1) = y
            ElseIf y <= x Then
                Cells(i, 8).Offset(0, 1) = y
            ElseIf y > x Then
                Do Until y <= x
                    Cells(i, j) = x
                    y = y - x
                    j = j + 1
                Loop
            End If
        Next i
    End With
End Sub

Side note: Indentation helps to see nesting. Adding indentation would be a good idea. — BigBen
– BigBen, Commented Jul 22, 2021 at 18:46

shrivallabha.redij · Accepted Answer · 2021-07-22 19:10:48Z

3

Your variables i, j, x are not being assigned Data type, only y is being assigned as variant.
If you are planning to use With construct then it should connect to its child objects via a . as demonstrated below.

Your first two conditions have the same action associated so they can be joined by OR.

 Sub Calc()

 Dim ws As Worksheet
 Dim i, j, x, y
 Dim lrow As Long

 Set ws = Workbooks("BC.xlsm").Worksheets("AB")
 lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

 With ws
     For i = 2 To lrow
         x = .Cells(i, 7).Value
         y = .Cells(i, 8).Value
         j = 9
         If y < 0 Or y <= x Then
             .Cells(i, j) = y
         ElseIf y > x Then
             Do Until y <= x
                 .Cells(i, j) = x
                 .Cells(i, j + 1) = y - x
                 y = y - x
                 j = j + 1
             Loop
         End If
     Next i
 End With

 End Sub

answered Jul 22, 2021 at 19:10

shrivallabha.redij

5,9021 gold badge15 silver badges28 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Nitin Over a year ago

These changes works as I needed. Thank you so much.

Scott Craner · Accepted Answer · 2021-07-22 19:02:12Z

1

I would use a for loop and some if logic inside:

Sub Calc()
    Dim ws As Worksheet
    Dim i As Long, j As Long, x as double, y as double
    Dim lrow As Long
    
    
    Set ws = Workbooks("BC.xlsm").Worksheets("AB")
    
    j = 9
    With ws
        lrow = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To lrow
            x = .Cells(i, 7).Value
            y = .Cells(i, 8).Value
            
            If y < 0 Then
                .Cells(i, j) = y
            ElseIf y <= x Then
                .Cells(i, j) = y
            ElseIf y > x Then
                For j = 9 To 8 + Application.RoundUp(y / x, 0)
                    If y >= x Then
                       .Cells(i, j) = x
                        y = y - x
                    Else
                        .Cells(i, j) = y
                    End If
                Next j
            End If
        Next i
    End With
End Sub

edited Jul 22, 2021 at 19:02

answered Jul 22, 2021 at 18:55

Scott Craner

153k10 gold badges52 silver badges88 bronze badges

1 Comment

Nitin Over a year ago

Thank you so much for the help. I tried this logic too but issue 3 seems to persist. I am not sure if I am doing something wrong or what but I copied and pasted the code as is.

Collectives™ on Stack Overflow

Nested IF & Do Until Loop | VBA

2 Answers 2

1 Comment

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related