VBA stuck in a loop I can't get out of

DrH100

Board Regular
Joined
Dec 30, 2011
Messages
78


Hi all

I’ve been given the code below which seems to do almostexactly what I want it to do but I’d like to make a couple of changes which iswhere I’m stuck


AsI understand it this code identifies if a cell has been changed then if thetotal in row 21 is higher than that of row 23 provides a message and shouldremove the entry. The removal bit doesn’tseem to be working so is one of my questions


HTML:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myRange As Range
    Dim col As Long


'   Set range to apply this to
    Set myRange = Range("E28:BB128")


'   Exit if more than one cell updated at a time
    If Target.CountLarge > 1 Then Exit Sub
    
'   Exit if cell updated is outside of designated range
   If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Get number of updated column
    col = Target.Column
    
  Check to see if row 1 is greater than row 2 in that column
    If Cells(20, col) > Cells(22, col) Then
       MsgBox "Greater Than Threshold, Has this Been Approved?", vbYesNo
                
    If answer = vbNo Then
      
    Application.EnableEvents = False
       Application.Undo
       Application.EnableEvents = True
      
      Else
              
    End If

End If
End Sub




The other change I’d like to make is if the user says “yes”to the question I would like them to be prompted for a password. If they know it all well and good and we moveon. If they don’t or they answer “no” tothe first question then I want the entry they have input to be removed. I tried adding in something I thought mightwork but I’ve ended up getting stuck in a loop which nowhere to go. Whichever answer is given it always seems totake me back to the password bit.





Here is my edited code.


HTML:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myRange As Range
    Dim col As Long
'   Set range to apply this to
    Set myRange = Range("E28:BB128")
'   Exit if more than one cell updated at a time
   If Target.CountLarge > 1 Then Exit Sub
    
'   Exit if cell updated is outside of designated range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Get number of updated column
    col = Target.Column
    
   'Check to see if row 1 is greater than row 2 in that column
    If Cells(21, col) > Cells(23, col) Then
        MsgBox "Leave Greater Than Threshold, Has Leave Been Approved?", vbYesNo
        
        If answer = vbNo Then
     
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
       Exit Sub
       
       Else
        
Message = "Please enter your password to authourise"
 Title = "Authourise"
 
 MyValue = InputBox(Message, Title, Default)
 If MyValue <> "Password" Then
 MsgBox "Invalid password - entry removed"
 Application.Undo
 Exit Sub
 End If
                   
    End If
End If
End Sub



Hopefully someone can understand what I’m looking to do .

As always, any help appreciated.


Thanks


 

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
first thought is it is a worksheet change event, and that probably drives your endless loop
 
Upvote 0
your need to change this....

Code:
 MyValue = InputBox(Message, Title, Default)
 If MyValue <> "Password" Then
 MsgBox "Invalid password - entry removed"
 Application.Undo
 Exit Sub
 End If

to this...

Code:
 MyValue = InputBox(Message, Title, Default)
 If MyValue <> "Password" Then
 MsgBox "Invalid password - entry removed"
Application.EnableEvents = False
 Application.Undo
Application.EnableEvents = true
 Exit Sub
 End If


the absence of the Application.EnableEvents = False before your second Application.Undo is what's doing it
 
Upvote 0
Thanks very much - I haven't tested it yet as I'm not in work but will do when I get back.

Thanks for the reply
 
Upvote 0
Please let me know if it works :D

Good luck!
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,947
Members
448,534
Latest member
benefuexx

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