Broken "Do Until" loop

cying

New Member
Joined
Jun 26, 2014
Messages
29
Hi. I have a macro that's supposed to check many individual accounts for a stock symbol, then see if there is enough of that stock symbol in the portfolio to sell or to see if there is enough cash to buy that stock symbol.

The part checking if there are enough shares to sell the amount I'm validating for is the part that's not working. If I try to validate the last account in the list of accounts, the macro checks column B indefinitely (even though the "END" is present). If I try to validate any account(s) other than the last one, it works fine.

It looks like this with the (assumed) malfunctioning part in red:

Code:
Sub Validate()
Dim TransactionType As String
Dim Symbol As String
Dim EstPrice As Double
Dim Confirm As String
Dim CurRelRow As Integer
CurRelRow = 0
Dim CurShare As Integer
CurShare = 0
Dim FidTotal, SchTotal, TDAtotal, OthTotal As Integer
 
FidTotal = 0
SchTotal = 0
TDAtotal = 0
OthTotal = 0
 
TransactionType = Range("R1")
If TransactionType = "" Then
    MsgBox "Please enter transaction type"
    Exit Sub
End If
Symbol = Range("R2")
If Symbol = "" Then
    MsgBox "Please enter symbol"
    Exit Sub
End If
EstPrice = Range("R3")
If EstPrice <= 0 Then
    MsgBox "Please enter an estimated price"
    Exit Sub
End If
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Validate Sell All
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If TransactionType = "Sell All" Then
    Confirm = MsgBox("Are you sure you want to sell all?", vbYesNo, "Confirm")
    If Confirm = vbYes Then
        Range("B9").Select
        Do Until ActiveCell.Value = "END"
            Cells(ActiveCell.Row, 18) = ""
            If ActiveCell.Value <> "" Then
                CurRelRow = ActiveCell.Row
            End If
            If UCase(Cells(ActiveCell.Row, 3).Value) = UCase(Symbol) Then
                Cells(CurRelRow, 18) = Cells(CurRelRow, 18) + Cells(ActiveCell.Row, 6)
            End If
            ActiveCell.Offset(1, 0).Select
        Loop
    Else
        MsgBox ("Validation Aborted")
    End If
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Validate Sell
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ElseIf TransactionType = "Sell" Then
    Range("B9").Select
    [COLOR=#ff0000]Do Until ActiveCell.Value = "END"
        CurShare = 0
        If Cells(ActiveCell.Row, 18) <> "" Then
            CurRelRow = ActiveCell.Row
            ActiveCell.Offset(1, 0).Select
            Do Until ActiveCell.Value <> ""
                If UCase(Cells(ActiveCell.Row, 3)) = UCase(Symbol) Then
                    CurShare = CurShare + Cells(ActiveCell.Row, 6)
                End If[/COLOR]
                If Cells(ActiveCell.Row, 18) <> "" Then
                    Cells(ActiveCell.Row, 18).Select
                    MsgBox ("Please enter shares at the correct row")
                    Exit Sub
                End If
                ActiveCell.Offset(1, 0).Select
            Loop
            If Cells(CurRelRow, 18) > CurShare Then
                Cells(CurRelRow, 18).Select
                MsgBox ("Shares oversold, please fix and validate again")
                Exit Sub
            End If
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Validate Buy
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
    Range("B9").Select
    Do Until ActiveCell.Value = "END"
        If Cells(ActiveCell.Row, 18) <> "" Then
            If ActiveCell = "" Then
                Cells(ActiveCell.Row, 18).Select
                MsgBox ("Please enter shares at the correct row")
                Exit Sub
            End If
            If Cells(ActiveCell.Row, 18).Value * EstPrice > Cells(ActiveCell.Row, 13).Value Then
                Cells(ActiveCell.Row, 18).Select
                MsgBox ("Amount bought exceeds available cash")
                Exit Sub
            End If
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
End If
 
Range("R9").Select
Do Until Cells(ActiveCell.Row, 1) = "END"
    If ActiveCell <> "" Then
        If Len(Cells(ActiveCell.Row, 3)) = 9 Then
            If InStr(Cells(ActiveCell.Row, 3), "-") = 5 Then
                SchTotal = SchTotal + Cells(ActiveCell.Row, 18).Value
            Else
                TDAtotal = TDAtotal + Cells(ActiveCell.Row, 18).Value
            End If
        ElseIf Len(Cells(ActiveCell.Row, 3)) = 10 Then
            FidTotal = FidTotal + Cells(ActiveCell.Row, 18).Value
        Else
            OthTotal = OthTotal + Cells(ActiveCell.Row, 18).Value
        End If
       
    End If
    ActiveCell.Offset(1, 0).Select
Loop
Cells(4, 18) = SchTotal
Cells(5, 18) = FidTotal
Cells(6, 18) = TDAtotal
Cells(7, 18) = OthTotal
 
MsgBox ("Validation completed")
 
End Sub

Please help! Thanks in advance!
 
I may not have been too clear

Code:
[COLOR=#0000ff][B]Loop [/B][/COLOR]   [COLOR=#006400]'After One Account is Processed it will go to the next account in Column C until it hits "END"[/COLOR]

The Accounts are in Column C. I meant that it will keep processing accounts in column C until it hits the word "END" in column B. Sorry for being ambiguous...

If the portion of code you referenced is in an infinite loop then a "" (blank) cell is not being found in Column C which triggers this loop to end. The blank cells seem to occur when accounts are separated.... No sure if this is the issue. When the code gets stuck you should see what row it keeps going down further and further.... The cursor will keep selecting one cell below the other. You would only be able to find this by stepping through the code as Fazza mentioned....

How big is the file you have? Is it possible to replace all sensitive information and upload a version to SkyDrive or DropBox. This would allow for debugging... If this is not possible I'm not sure where to go from here. Flying blind at this point......
 
Upvote 0

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Hi. I only got a chance to remove sensitive information from a couple of accounts out of hundreds for today. Running the code as-is though does still give the infinite loop problem though.

The link is here:

https://db.tt/8k5AjcSz

I've tried Fazza's F8 debugging method, which shows me that the loop in my previous reply is the one that keeps repeating.

Thanks again for your help!
 
Upvote 0
cying,

Try This:

1. Put the word "END" at the bottom of Data in Column B
2. Put the word "END" at the bottom of Data in Column R

Make this modification to the code:
Code:
[COLOR=#008000]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
[COLOR=#008000]'Validate Sell[/COLOR]
[COLOR=#008000]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]


   [COLOR=#0000ff] ElseIf [/COLOR]TransactionType = "Sell" [COLOR=#0000ff]Then[/COLOR]
        Range("B9").Select
       [COLOR=#0000ff] Do Until [/COLOR]ActiveCell.Value = "END"   
            CurShare = 0                       
           [COLOR=#0000ff] If[/COLOR] Cells(ActiveCell.Row, 18) <> "" [COLOR=#0000ff]Then[/COLOR]
                CurRelRow = ActiveCell.Row
                ActiveCell.Offset(1, 0).Select
              [COLOR=#0000ff]  Do Until [/COLOR]ActiveCell.Value <> ""
                   [COLOR=#0000ff] If[/COLOR] UCase(Cells(ActiveCell.Row, 3)) = UCase(Symbol) [COLOR=#0000ff]Then [/COLOR]
                        CurShare = CurShare + Cells(ActiveCell.Row, 6)      
[COLOR=#0000ff]                    End If                                    [/COLOR]
[SIZE=3][COLOR=#ff0000][B]                       ' Cells(ActiveCell.Row, 18).Select   '<--------Comment this line out or delete it and run the procedure again[/B][/COLOR][/SIZE]
                  [COLOR=#0000ff]  If[/COLOR] Cells(ActiveCell.Row, 18) <> "" [COLOR=#0000ff]Then [/COLOR]                          
                        MsgBox ("Please enter shares at the correct row")       
[COLOR=#0000ff]                        Exit Sub[/COLOR]
[COLOR=#0000ff]                    End If[/COLOR]
                    ActiveCell.Offset(1, 0).Select
[COLOR=#0000ff]                Loop[/COLOR]
               [COLOR=#0000ff] If[/COLOR] Cells(CurRelRow, 18) > CurShare [COLOR=#0000ff]Then[/COLOR]
                    Cells(CurRelRow, 18).Select
                    MsgBox ("Shares oversold, please fix and validate again") 
[COLOR=#0000ff]                    Exit Sub[/COLOR]
[COLOR=#0000ff]                End If[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
            ActiveCell.Offset(1, 0).Select
[COLOR=#0000ff]        Loop[/COLOR]

Test this on a small subset of data. If it seems to resolve the issue test it on a larger set of data with multiple stock values on the grey lines. If it still works then you should be good.

Report back and let me know if this fixes your issue. If it doesn't then we can try again :)
 
Upvote 0
cying,

Try This:

1. Put the word "END" at the bottom of Data in Column B
2. Put the word "END" at the bottom of Data in Column R

Make this modification to the code:
Code:
[COLOR=#008000]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
[COLOR=#008000]'Validate Sell[/COLOR]
[COLOR=#008000]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]


   [COLOR=#0000ff] ElseIf [/COLOR]TransactionType = "Sell" [COLOR=#0000ff]Then[/COLOR]
        Range("B9").Select
       [COLOR=#0000ff] Do Until [/COLOR]ActiveCell.Value = "END"   
            CurShare = 0                       
           [COLOR=#0000ff] If[/COLOR] Cells(ActiveCell.Row, 18) <> "" [COLOR=#0000ff]Then[/COLOR]
                CurRelRow = ActiveCell.Row
                ActiveCell.Offset(1, 0).Select
              [COLOR=#0000ff]  Do Until [/COLOR]ActiveCell.Value <> ""
                   [COLOR=#0000ff] If[/COLOR] UCase(Cells(ActiveCell.Row, 3)) = UCase(Symbol) [COLOR=#0000ff]Then [/COLOR]
                        CurShare = CurShare + Cells(ActiveCell.Row, 6)      
[COLOR=#0000ff]                    End If                                    [/COLOR]
[SIZE=3][COLOR=#ff0000][B]                       ' Cells(ActiveCell.Row, 18).Select   '<--------Comment this line out or delete it and run the procedure again[/B][/COLOR][/SIZE]
                  [COLOR=#0000ff]  If[/COLOR] Cells(ActiveCell.Row, 18) <> "" [COLOR=#0000ff]Then [/COLOR]                          
                        MsgBox ("Please enter shares at the correct row")       
[COLOR=#0000ff]                        Exit Sub[/COLOR]
[COLOR=#0000ff]                    End If[/COLOR]
                    ActiveCell.Offset(1, 0).Select
[COLOR=#0000ff]                Loop[/COLOR]
               [COLOR=#0000ff] If[/COLOR] Cells(CurRelRow, 18) > CurShare [COLOR=#0000ff]Then[/COLOR]
                    Cells(CurRelRow, 18).Select
                    MsgBox ("Shares oversold, please fix and validate again") 
[COLOR=#0000ff]                    Exit Sub[/COLOR]
[COLOR=#0000ff]                End If[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
            ActiveCell.Offset(1, 0).Select
[COLOR=#0000ff]        Loop[/COLOR]

Test this on a small subset of data. If it seems to resolve the issue test it on a larger set of data with multiple stock values on the grey lines. If it still works then you should be good.

Report back and let me know if this fixes your issue. If it doesn't then we can try again :)

Sorry mrmmickle1, things got really hectic around here. I did try your fix, and it doesn't work. Deleting the bottom most account (account005b) and entering a number into R52 (selling part of the 250 shares available), makes validate run infinitely.
 
Upvote 0
cying,

When you run the code are you using F8 to step through the code one line at a time? Or are you just hitting F5? The reason I found the Macro to run infinitely had to do with the cell selection continuing to go down column R without finding the word "END". Essentially the code switches back and forth between Column C and Column R going back and forth depending what the criteria in each column contains. So at the end of your data the cursor can either be in Column R or Column C. If the word "END" does not appear then the code will go through 1,048,576 rows (Thus the "infinite loop"). Can you verify that the code goes past these two "END" words in column C and R by debugging the code and watching the cursor on the screen go through the cells(to do this you will need to have both the VBE and the your worksheet visible? Please try this step and report back. You may observe something strange that you did not expect, that is causing the issue.

If you still have issues after stepping through the code one line at a time I will be happy to look into this further. The person who wrote this code probably should have defined variable when to stop (Like LastRow = Range("A" & Rows.Count).End(xlUp).Row) rather then the word "END"....
 
Upvote 0
cying,

When you run the code are you using F8 to step through the code one line at a time? Or are you just hitting F5? The reason I found the Macro to run infinitely had to do with the cell selection continuing to go down column R without finding the word "END". Essentially the code switches back and forth between Column C and Column R going back and forth depending what the criteria in each column contains. So at the end of your data the cursor can either be in Column R or Column C. If the word "END" does not appear then the code will go through 1,048,576 rows (Thus the "infinite loop"). Can you verify that the code goes past these two "END" words in column C and R by debugging the code and watching the cursor on the screen go through the cells(to do this you will need to have both the VBE and the your worksheet visible? Please try this step and report back. You may observe something strange that you did not expect, that is causing the issue.

If you still have issues after stepping through the code one line at a time I will be happy to look into this further. The person who wrote this code probably should have defined variable when to stop (Like LastRow = Range("A" & Rows.Count).End(xlUp).Row) rather then the word "END"....

In the version with the
Code:
[SIZE=3][COLOR=#ff0000][B]' Cells(ActiveCell.Row, 18).Select[/B][/COLOR][/SIZE]
line taken out, it doesnt search for "END" in column R. It just goes over column C as if "END" is not there even though it is.

It goes from:

Code:
Do Until ActiveCell.Value = "END"
        CurShare = 0

to the end if before the loop. I don't understand why it does this as there is clearly an "END" in column C, and it's a do until loop. Is there some way the END is different from the END it's looking for? </pre>
 
Upvote 0
I'll have another look at this later this evening. The data set that you provided me is the one I tested the code on. The loop does not occur on this one after making the modifications. Is the data you are using now somehow different?

Another observation: if this only just stopped working recently.... do you have historical copies of data? Are the data sets different? If so in what way?

Can you provide the data you are using that is running infinitely? Or perhaps a workbook with several scenarios on separate sheets(All Sensitive Data Removed)?

I would really like to help get your issue solved! :)
 
Upvote 0
I'll have another look at this later this evening. The data set that you provided me is the one I tested the code on. The loop does not occur on this one after making the modifications. Is the data you are using now somehow different?

Another observation: if this only just stopped working recently.... do you have historical copies of data? Are the data sets different? If so in what way?

Can you provide the data you are using that is running infinitely? Or perhaps a workbook with several scenarios on separate sheets(All Sensitive Data Removed)?

I would really like to help get your issue solved! :)

I added some new rows to the sample data:

https://db.tt/8k5AjcSz

It's important to have the last account contain the symbol in question (JPM here) to sell, or else the macro works correctly. Sorry, in the original data, the final account did not contain JPM, and the macro only breaks when the last account has a sell quantity in R.

Apparently the macro has never worked correctly, but it was only recently brought to my attention because the portfolio managers simply started excluding the last account from sell orders to avoid the problem. But when they forget, it bogs down their system for awhile running the loop. I can provide another workbook with something similar, but it may take awhile unfortunately as I am not the one who normally runs these.

I really do appreciate the effort you're putting into this! Thanks so much mrmmickle1.
 
Upvote 0
Try this version of the Validate Sell code on test data:

Code:
[COLOR=#008000]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
[COLOR=#008000]'Validate Sell[/COLOR]
[COLOR=#008000]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
[COLOR=#0000ff]ElseIf [/COLOR]TransactionType = "Sell" [COLOR=#0000ff]Then[/COLOR]
    Range("B9").Select
[COLOR=#0000ff]    Do Until[/COLOR] ActiveCell.Value = "END"
        CurShare = 0
      [COLOR=#0000ff]  If [/COLOR]Cells(ActiveCell.Row, 18) = "" [COLOR=#0000ff]Then[/COLOR]
            CurRelRow = ActiveCell.Row
            ActiveCell.Offset(1, 0).Select
          [COLOR=#0000ff]  Do Until [/COLOR]ActiveCell.Offset(1, 0).Value <> ""
                [COLOR=#0000ff]If[/COLOR] UCase(Cells(ActiveCell.Row, 3)) = UCase(Symbol) [COLOR=#0000ff]Then[/COLOR]
                    CurShare = CurShare + Cells(ActiveCell.Row, 6)
[COLOR=#0000ff]                End If[/COLOR]
              [COLOR=#0000ff]  If [/COLOR]Cells(ActiveCell.Row, 18) <> "" [COLOR=#0000ff]Then[/COLOR]
                    Cells(ActiveCell.Row, 18).Select
                    MsgBox ("Please enter shares at the correct row")
[COLOR=#0000ff]                    Exit Sub[/COLOR]
[COLOR=#0000ff]                End If[/COLOR]
                ActiveCell.Offset(1, 0).Select
[COLOR=#0000ff]            Loop[/COLOR]
            
          [COLOR=#0000ff]  If[/COLOR] Cells(CurRelRow, 18) > CurShare [COLOR=#0000ff]Then[/COLOR]
                Cells(CurRelRow, 18).Select
                MsgBox ("Shares oversold, please fix and validate again")
[COLOR=#0000ff]                Exit Sub[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]
        ActiveCell.Offset(1, 0).Select
[COLOR=#0000ff]    Loop[/COLOR]

Sorry for the delay in responding I have been traveling a little bit lately and lost track of the thread.

Please make sure to throw in some curve balls to test under normal circumstances... (i.e. Purposely make your data so that it will result in msgboxes then do the opposite)

In other words make the data where it purposely hits these code lines:

Code:
     MsgBox ("Please enter shares at the correct row")
Code:
     MsgBox ("Shares oversold, please fix and validate again")
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,356
Messages
6,124,471
Members
449,163
Latest member
kshealy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top