VBA code for my page causing Excel to Crash to desktop and restart

Printable View

07-03-2013, 05:56 AM
william516

VBA code for my page causing Excel to Crash to desktop and restart

I have opened a new question after people have helped me figure out how to get my first problem fixed, now I have a new problem. You will find the coding on the "INITIATING DEVICES" page below. The idea for the second to last part of the code was to add columns (text values) from B7:b and E7:E and display it on column J7:J. So if Photo is entered into B and Pass is entered into column E then the result will be Photopass in column J. The original code works fine if run via the macro command. The problem is that I tried to add it into some of my existing code and now the whole entire program will crash when information is entered into ANY cell. The program becomes unresponsive and then it shuts down and starts up again. I don't get a code or Debug message. Here is the entire code on the page.

Code:

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 7 And UCase(Target.Value) = "YES" Then Sheets("MESSAGE CHANGES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value Application.Goto Sheets("MESSAGE CHANGES").Cells(Rows.Count, 1).End(xlUp).Offset(, 3) End If If Target.Column = 6 And UCase(Target.Value) = "YES" Then Sheets("DEVICE NOTES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value Application.Goto Sheets("DEVICE NOTES").Cells(Rows.Count, 1).End(xlUp).Offset(, 3) End If '(replace if new code fails)If Target.Column = 5 And UCase(Target.Value) = "FAIL" Or Target.Column = 5 And UCase(Target.Value) = "DAMAGED" Then '(replace if new codes fails)Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value If Target.Column = 5 And UCase(Target.Value) = "FAIL" Or UCase(Target.Value) = "DAMAGED" Then Application.EnableEvents = False Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 5) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 5).Value Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp).Offset(, 5) = Sheets("INITIATING DEVICES").Cells(Target.Row, 11).Value Application.EnableEvents = True End If 'code that will place date/time when value is selcted in E If Not Intersect(Target, Range("E:E")) Is Nothing Then Range("I" & Target.Row).Value = Now End If Dim wb As Workbook Dim ws As Worksheet Dim lastRow As Long Set wb = ThisWorkbook Set ws = wb.Sheets("INITIATING DEVICES") lastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row ws.Range("J7:J" & lastRow).Value = Evaluate("=B7:B" & lastRow & "&E7:E" & lastRow) End Sub Private Sub Workbook_BeforePrint(Cancel As Boolean) With Sheets("INITIATING DEVICES") .PageSetup.PrintArea = .Range("A1:H" & .Cells(Rows.Count, 1).End(xlUp).Row).Address End With End Sub

Thank you for any help that you can give me, if you need anymore information I can send the inspection file and also offer more information if needed. I'm sure I messed something up and that's why it keeps crashing. Still learning here.
07-03-2013, 10:00 AM
Rick Rothstein

I think your problem is you have your code in the Change event and that code is changing cells within the columns you are monitoring... than change by your code is kicking off the Change event again which makes another change to the same column thus kicking off the Change event again... this process goes on until Excel locks up or crashes. If I am right, you can solve your problem by putting this line of code as the first line of code in the Change event...

Application.EnableEvents = False

and then putting this line of code as the last line of code in the Change event...

Application.EnableEvents = True

I don't see this occurring in the code you posted, but for future information, if your code can raise an error so that you need an On Error statement of one kind or another, then make sure you execute the Application.EnableEvents=True statement before you let your error trap end the subroutine.
07-03-2013, 04:51 PM
william516

Wow I'm lost, sorry so would I simply add that code to my page code above or does it have to go somewhere special. I would elaborate a little more but I'm replying from my phone so I can't look at the vba code at this second. I'm just confused as to what or where that code would go in my vba page code. Thanks I will look at the coding later when I get a second. I'm guessing I basically created a never ending loop then.
07-04-2013, 04:38 AM
william516

Ok so below is the modification that I used. You can see where I posted the codes per your recommendation. Now the interesting thing is that when I when I ran the code it seemed to work until I got down a couple of lines and then I got an error. I ran bebug and it flagged a line of my code.

Code:

If Target.Column = 7 And UCase(Target.Value) = "YES" Then

Now it seemed that after I tried to figure out what happened, and ended the debug session and then hit the button to re-run or enable my macros again (the button that exits break mode) none of the macros work again for this page. I checked to make sure break mode was exited but still nothing. I'm assuming it has something to do with where the code stopped or was flagged but im not sure what I did or what went wrong.

Code:

Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Column = 7 And UCase(Target.Value) = "YES" Then Sheets("MESSAGE CHANGES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value Application.Goto Sheets("MESSAGE CHANGES").Cells(Rows.Count, 1).End(xlUp).Offset(, 3) End If If Target.Column = 6 And UCase(Target.Value) = "YES" Then Sheets("DEVICE NOTES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value Application.Goto Sheets("DEVICE NOTES").Cells(Rows.Count, 1).End(xlUp).Offset(, 3) End If '(replace if new code fails)If Target.Column = 5 And UCase(Target.Value) = "FAIL" Or Target.Column = 5 And UCase(Target.Value) = "DAMAGED" Then '(replace if new codes fails)Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value If Target.Column = 5 And UCase(Target.Value) = "FAIL" Or UCase(Target.Value) = "DAMAGED" Then Application.EnableEvents = False Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 5) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 5).Value Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp).Offset(, 5) = Sheets("INITIATING DEVICES").Cells(Target.Row, 11).Value Application.EnableEvents = True End If 'code that will place date/time when value is selcted in E If Not Intersect(Target, Range("E:E")) Is Nothing Then Range("I" & Target.Row).Value = Now End If Dim wb As Workbook Dim ws As Worksheet Dim lastRow As Long Set wb = ThisWorkbook Set ws = wb.Sheets("Initiating Devices") lastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row ws.Range("J7:J" & lastRow).Value = Evaluate("=B7:B" & lastRow & "&E7:E" & lastRow) Application.EnableEvents = True End Sub
07-04-2013, 04:50 AM
william516

Ok I'm stupid sorry, I figured out what the problem is and I found out where the code needed to be placed. So far it seems to be working.