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!
 
PLEASE DISREGARD THE LAST POST

I was incorrect. This should fix your issue:

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]
[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]
       [COLOR=#0000ff] If[/COLOR] ActiveCell.Value <> "END"[COLOR=#0000ff] Then [/COLOR]      [COLOR=#008000]<-- This section should fix your issue.  The code wasn't evaluating whether "END" was in the activecell[/COLOR]
            ActiveCell.Offset(1, 0).Select                [COLOR=#008000]'If the activecell = "END" this new code will now Exit the Do Loop[/COLOR]
[COLOR=#0000ff]                Else[/COLOR]
[COLOR=#0000ff]            Exit Do[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]
[COLOR=#0000ff]    Loop[/COLOR]
 
Upvote 0

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
PLEASE DISREGARD THE LAST POST

I was incorrect. This should fix your issue:

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]
[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]
       [COLOR=#0000ff] If[/COLOR] ActiveCell.Value <> "END"[COLOR=#0000ff] Then [/COLOR]      [COLOR=#008000]<-- This section should fix your issue.  The code wasn't evaluating whether "END" was in the activecell[/COLOR]
            ActiveCell.Offset(1, 0).Select                [COLOR=#008000]'If the activecell = "END" this new code will now Exit the Do Loop[/COLOR]
[COLOR=#0000ff]                Else[/COLOR]
[COLOR=#0000ff]            Exit Do[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]
[COLOR=#0000ff]    Loop[/COLOR]

Unfortunately, the extra if statement did not fix the bug :(

I'll do more to get the message boxes to pop up.
 
Upvote 0
Hmmm. This seemed to fix the "infinite loop" with the file that you last posted on dropbox. Do you mean that the validation was incorrect? Or is the infinite loop still occurring? When I run the procedure on the file you provided it ends with the "Validation completed" msgbox.

Did you try the code on the file you provided and see if it worked against it or did you go straight to a copy of your real data?
 
Upvote 0
Hmmm. This seemed to fix the "infinite loop" with the file that you last posted on dropbox. Do you mean that the validation was incorrect? Or is the infinite loop still occurring? When I run the procedure on the file you provided it ends with the "Validation completed" msgbox.

Did you try the code on the file you provided and see if it worked against it or did you go straight to a copy of your real data?

mrmmickle1 you are awesome! you totally made my day and that of the portfolio managers! IT WORKS!!

i had originally typed the new if statement in manually to keep my annotations because it looked like that's the only thing you changed, and it didn't work. Now I just said screw it and copy/pasted your entire code into the relevant section, and it works! It works on my dropbox file and on the original file with the real data. I hope it holds up in the future!

Thank you SO MUCH you have been extremely helpful and patient this entire time.
 
Upvote 0
Your very welcome. Sorry it took so long to get your problem sorted!

I hate to being it back up (I really do!), but apparently I'm having trouble with this code again..

Code:
Sub Validate()

Dim TransactionType     As String
Dim Symbol              As String
Dim Confirm             As String
Dim EstPrice            As Double
Dim CurRelRow           As Integer
Dim CurShare            As Integer
Dim FidTotal            As Integer
Dim SchTotal            As Integer
Dim TDAtotal            As Integer
Dim OthTotal            As Integer

TransactionType = Range("R1")
Symbol = Range("R2")
EstPrice = Range("R3")

If TransactionType = "" Or Symbol = "" Or EstPrice <= 0 Then
    MsgBox "Please check cells R1, R2 & R3 to make sure" & vbLf & _
    "the values are not missing or below zero.", vbCritical, "Please Check Data"
    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
    Do Until ActiveCell.Value = "END"                                       'Go through Column B until the word "END" is found then Stop
        CurShare = 0                                                        'This line resets the CurShare Value for each Specific Account
        If Cells(ActiveCell.Row, 18) <> "" Then
            CurRelRow = ActiveCell.Row
            ActiveCell.Offset(1, 0).Select
            Do Until ActiveCell.Value <> ""
                [COLOR=#ff0000]If UCase(Cells(ActiveCell.Row, 3)) = UCase(Symbol) Then     'Looks in Column C for JPM
                    CurShare = CurShare + Cells(ActiveCell.Row, 6)          'If JPM is found it adds to the Quantity in Column F
                End If                                                      'If the Quantity in Column R is Greater then the sum of JPM in Column F Then you get the Shares Oversold MsgBox
                'Cells(ActiveCell.Row, 18).Select
                If Cells(ActiveCell.Row, 18) <> "" Then                     'This checks to make sure there is not more then one value in Column R for a specified account
                    Cells(ActiveCell.Row, 18).Select
                    MsgBox ("Please enter shares at the correct row")       '<---- If more than one value in Column R for an account then this MsgBox appears
                    Exit Sub
                End If
                ActiveCell.Offset(1, 0).Select[/COLOR]
            Loop
            If Cells(CurRelRow, 18) > CurShare Then
                Cells(CurRelRow, 18).Select
                MsgBox ("Shares oversold, please fix and validate again")   ' <------If the SUM of Column F exceeds the value in Column R you will get this MsgBox
                Exit Sub
            End If
        End If
        If ActiveCell.Value <> "END" Then
            ActiveCell.Offset(1, 0).Select                                  'If the activecell = "END" this new code will now Exit the Do Loop
                Else
            Exit Do
        End If
    Loop                                                                    'After One Account is Processed it will go to the next account in Column C until it hits "END"
    
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'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

Specifically, the parts in red. The code does not verify that the account in question indeed has the correct symbol (column C) anymore. Also, if I enter the quantity in the incorrect row, I get the "shared oversold.." text instead of the "Please enter shares at the correct row" text.
THANKFULLY the infinite loop problem is gone though thanks to @mrmmickle1!!

Can anyone provide some insight into this?

I have a sample spreadsheet in dropbox:

https://db.tt/8k5AjcSz

Thanks!
 
Upvote 0
I stepped through the code. I don't see any issues. Do you have a trailing or leading space? (For the Symbol)


Do you know how to debug the code by using break points? It may be beneficial to see what value is attributed to Cells(ActiveCell.Row, 18) when the code triggers the msgbox..

You can use this line:

Code:
[COLOR=#ff0000] If Cells(ActiveCell.Row, 18) <> "" Then                     'This checks to make sure there is not more then one value in Column R for a specified account
                    Cells(ActiveCell.Row, 18).Select

[/COLOR][COLOR=#0000ff]Debug.Print [FONT=Verdana]Cells(ActiveCell.Row, 18).Value[/FONT][/COLOR][COLOR=#ff0000]
[/COLOR][COLOR=#ff0000]
                    MsgBox ("Please enter shares at the correct row")       '<---- If more than one value in Column R for an account then this MsgBox appears
                    Exit Sub
                End If[/COLOR]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,651
Messages
6,120,744
Members
448,989
Latest member
mariah3

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