Excel Crashing

Blobajob88

Board Regular
Joined
Mar 27, 2020
Messages
55
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi,

I've produced code in the activate and change events on a spreadsheet I am working on and it keeps crashing my computer. Could someone please have a look at my code and figure out why. It technically works but is too demanding of my laptop

VBA Code:
Private Sub Worksheet_Activate()

ThisWorkbook.Worksheets("Procurement Schedule").Protect userinterfaceonly:=True

Range("p3").Value = DateDiff("d", Date, Range("o3").Value) & " Days Until Skid Completion"
If DateDiff("d", Date, Range("o3").Value) >= 21 Then
Range("p3").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o3").Value) >= 10 And DateDiff("d", Date, Range("o3").Value) < 21 Then
Range("p3").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o3").Value) < 10 Then
Range("p3").Font.Color = rgbRed
End If

Range("p4").Value = DateDiff("d", Date, Range("o4").Value) & " Days Until Kiosk Completion"
If DateDiff("d", Date, Range("o4").Value) >= 21 Then
Range("p4").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o4").Value) >= 10 And DateDiff("d", Date, Range("o4").Value) < 21 Then
Range("p4").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o4").Value) < 10 Then
Range("p4").Font.Color = rgbRed
End If

Range("p5").Value = DateDiff("d", Date, Range("o5").Value) & " Days Until Site Completion"
If DateDiff("d", Date, Range("o5").Value) >= 21 Then
Range("p5").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o5").Value) >= 10 And DateDiff("d", Date, Range("o5").Value) < 21 Then
Range("p5").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o5").Value) < 10 Then
Range("p5").Font.Color = rgbRed
End If

x = Cells(Rows.Count, 2).End(xlUp).Row

'If Not Application.Intersect(Target, Range("k3:z60")) Is Nothing Then

'For i = 8 To x
''
'If Range("m" & i).Value = "" Or Range("o" & i).Value = "" Then
'Range("R" & i).Value = "Enter an Order & a Lead Time"
'End If
'Next i


'End If


End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

ThisWorkbook.Worksheets("Procurement Schedule").Unprotect

Application.ScreenUpdating = False

x = Cells(Rows.Count, 2).End(xlUp).Row

Dim Rng As Range
Set Rng = Range("m8:m" & x)

If Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Then

  
    For Each Cell In Rng
        If Cell.Value > "" And Not IsDate(Cell.Value) Then
            Cell.Value = ""
            Cell.Select
            MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
     
        End If
     

    Next


End If


'Data validation for skid/kiosk/site completion dates
If Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then
Dim Rng9 As Range
Set Rng9 = Range("o3:o5")
    For Each Cell In Rng9
        If Cell.Value > "" And Not IsDate(Cell.Value) Then
            Cell.Value = ""
            Cell.Select
            MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
        End If
    Next
End If

'Data validation for project delivery date
If Not Application.Intersect(Target, Range("I5")) Is Nothing Then
Dim Rng10 As Range
Set Rng10 = Range("I5")
    For Each Cell In Rng9
        If Cell.Value > "" And Not IsDate(Cell.Value) Then
            Cell.Value = ""
            Cell.Select
            MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
        End If
    Next
End If


Range("B7").CurrentRegion.Borders.LineStyle = xlContinuous
Range("B7").CurrentRegion.BorderAround _
ColorIndex:=0, Weight:=xlThick
Range("B7:V7").BorderAround ColorIndex:=0, Weight:=xlThick


Columns("A:Z").AutoFit

'if value in 'How many have you ordered?' and 'How many are in stock?' then the 'Quantity left to order' value changes


If Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then

Range("p3").Value = DateDiff("d", Date, Range("o3").Value) & " Days Until Skid Completion"
If DateDiff("d", Date, Range("o3").Value) >= 21 Then
Range("p3").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o3").Value) >= 10 And DateDiff("d", Date, Range("o3").Value) < 21 Then
Range("p3").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o3").Value) < 10 Then
Range("p3").Font.Color = rgbRed
End If

Range("p4").Value = DateDiff("d", Date, Range("o4").Value) & " Days Until Kiosk Completion"
If DateDiff("d", Date, Range("o4").Value) >= 21 Then
Range("p4").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o4").Value) >= 10 And DateDiff("d", Date, Range("o4").Value) < 21 Then
Range("p4").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o4").Value) < 10 Then
Range("p4").Font.Color = rgbRed
End If

Range("p5").Value = DateDiff("d", Date, Range("o5").Value) & " Days Until Site Completion"
If DateDiff("d", Date, Range("o5").Value) >= 21 Then
Range("p5").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o5").Value) >= 10 And DateDiff("d", Date, Range("o5").Value) < 21 Then
Range("p5").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o5").Value) < 10 Then
Range("p5").Font.Color = rgbRed
End If
End If

'expected delivery date Status
If Not Application.Intersect(Target, Range("n8:n" & x)) Is Nothing Or Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Or Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then

Dim Rng2 As Range

Set Rng2 = Range("r8:r" & x)

For Each Cell In Rng2

If Cell.Value <> "" Then

If Cell.Value - Range("o3").Value >= 0 Then
    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"


ElseIf Range("o3").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Skid Mechanical" Or Cell.Offset(0, -8).Value = "Skid Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o3").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Skid Mechanical" Or Cell.Offset(0, -8).Value = "Skid Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"

ElseIf Range("o4").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Kiosk Mechanical" Or Cell.Offset(0, -8).Value = "Kiosk Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o4").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Kiosk Mechanical" Or Cell.Offset(0, -8).Value = "Kiosk Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o5").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Site Mechanical" Or Cell.Offset(0, -8).Value = "Site Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"

ElseIf Range("o5").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Site Mechanical" Or Cell.Offset(0, -8).Value = "Site Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
Else

End If

Else
    Cell.Interior.ColorIndex = 0
    

End If
Next
End If


'Actual delivery date Status
If Not Application.Intersect(Target, Range("o8:o" & x)) Is Nothing Or Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Or Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then

Dim Rng3 As Range

Set Rng3 = Range("s8:s" & x)

For Each Cell In Rng3

If Cell.Value <> "" Then

If Cell.Value - Range("o3").Value >= 0 Then
    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"


ElseIf Range("o3").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Skid Mechanical" Or Cell.Offset(0, -9).Value = "Skid Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o3").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Skid Mechanical" Or Cell.Offset(0, -9).Value = "Skid Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"

ElseIf Range("o4").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Kiosk Mechanical" Or Cell.Offset(0, -9).Value = "Kiosk Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o4").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Kiosk Mechanical" Or Cell.Offset(0, -9).Value = "Kiosk Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
ElseIf Range("o5").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Site Mechanical" Or Cell.Offset(0, -9).Value = "Site Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbRed
    Cell.NumberFormat = "dddd dd mmmm yyyy"

ElseIf Range("o5").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Site Mechanical" Or Cell.Offset(0, -9).Value = "Site Electrical") Then

    Cell.Font.Color = rgbWhite
    Cell.Interior.Color = rgbGreen
    Cell.NumberFormat = "dddd dd mmmm yyyy"
    
Else

End If

Else
    Cell.Interior.ColorIndex = 0
    

End If
Next
End If

'Determining procurement Status
If Not Application.Intersect(Target, Range("E8:E" & x)) Is Nothing Then

For i = 8 To x
If Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) <= 0 Then
Cells(i, 16).Value = "Complete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) >= 0 Then
Cells(i, 16).Value = "Incomplete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Partially Ordered"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value >= Cells(i, 4).Value Then
Cells(i, 16).Value = "Complete: Fully Ordered"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) = 0 And Cells(i, 4).Value > 0 Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Nothing in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 7).Value <= 0 Then
Cells(i, 16).Value = "Complete: All in Stock"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 4).Value > 0 And Cells(i, 7).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Some in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite

End If

Next i
End If

If Not Application.Intersect(Target, Range("F8:F" & x)) Is Nothing Then

For i = 8 To x
If Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) <= 0 Then
Cells(i, 16).Value = "Complete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) >= 0 Then
Cells(i, 16).Value = "Incomplete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Partially Ordered"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value >= Cells(i, 4).Value Then
Cells(i, 16).Value = "Complete: Fully Ordered"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) = 0 And Cells(i, 4).Value > 0 Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Nothing in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 7).Value <= 0 Then
Cells(i, 16).Value = "Complete: All in Stock"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 4).Value > 0 And Cells(i, 7).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Some in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite

End If

Next i
End If

'data validation for column k (unit cost)
If Not Application.Intersect(Target, Range("k8:k" & x)) Is Nothing Then
Dim Rng5 As Range

    Set Rng5 = Range("K8:k" & x)
    For Each Cell In Rng5

    If Cell.Value < 0 Then
    MsgBox "Please enter a positive number"
    Cell.Select
    Cell.Value = ""
    End If
    
    If Not IsNumeric(Cell.Value) Then
    MsgBox "Please Enter a Numeric Value"
    Cell.Select
    Cell.Value = ""
    End If

    Next
    
End If

'data validation for column O (Actual Lead Time)
If Not Application.Intersect(Target, Range("o8:o" & x)) Is Nothing Then
Dim Rng6 As Range

    Set Rng6 = Range("o8:o" & x)
    For Each Cell In Rng6

    If Cell.Value < 0 Then
    MsgBox "Please enter a positive number"
    Cell.Select
    Cell.Value = ""
    End If
    
    If Not IsNumeric(Cell.Value) Then
    MsgBox "Please Enter a Numeric Value"
    Cell.Select
    Cell.Value = ""
    End If

    Next
    
End If

'data validation for column E (Number Ordered)
If Not Application.Intersect(Target, Range("e8:e" & x)) Is Nothing Then
Dim Rng7 As Range

    Set Rng7 = Range("e8:e" & x)
    For Each Cell In Rng7

    If Cell.Value < 0 Then
    MsgBox "Please enter a positive number"
    Cell.Select
    Cell.Value = ""
    End If
    
    If Not IsNumeric(Cell.Value) Then
    MsgBox "Please Enter a Numeric Value"
    Cell.Select
    Cell.Value = ""
    End If

    Next
    
End If


'data validation for column E (Number In Stock)
If Not Application.Intersect(Target, Range("f8:f" & x)) Is Nothing Then
Dim Rng8 As Range

    Set Rng8 = Range("f8:f" & x)
    For Each Cell In Rng8

    If Cell.Value < 0 Then
    MsgBox "Please enter a positive number"
    Cell.Select
    Cell.Value = ""
    End If
    
    If Not IsNumeric(Cell.Value) Then
    MsgBox "Please Enter a Numeric Value"
    Cell.Select
    Cell.Value = ""
    End If

    Next
    
End If

'Determing delivery date status

'If Not Application.Intersect(Target, Range("r8:r" & x)) Is Nothing Or Not Application.Intersect(Target, Range("O3")) Is Nothing Then
'For i = 8 To x
'If (Cells(i, 10).Value = "Skid Mechanical" Or Cells(i, 10).Value = "Skid Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Skid Mechanical" Or Cells(i, 10).Value = "Skid Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'If (Cells(i, 10).Value = "Kiosk Mechanical" Or Cells(i, 10).Value = "Kiosk Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Kiosk Mechanical" Or Cells(i, 10).Value = "Kiosk Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'If (Cells(i, 10).Value = "Site Mechanical" Or Cells(i, 10).Value = "Site Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Site Mechanical" Or Cells(i, 10).Value = "Site Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'
'Next i
'End If


For i = 1 To x

If Worksheets("Procurement Schedule").Range("H" & i).Value = "Kiosk Electrical" Then
Range("h" & i).Interior.Color = rgbDarkGreen
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("H" & i).Value = "Kiosk Mechanical" Then
Range("h" & i).Interior.Color = rgbYellow
Range("h" & i).Font.Color = rgbBlack
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Skid Electrical" Then
Range("h" & i).Interior.Color = rgbBlue
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Skid Mechanical" Then
Range("h" & i).Interior.Color = rgbGrey
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Site Electrical" Then
Range("h" & i).Interior.Color = rgbPurple
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Site Mechanical" Then
Range("h" & i).Interior.Color = rgbLightGrey
Range("h" & i).Font.Color = rgbBlack
End If
Next i

'ThisWorkbook.Worksheets("Procurement Schedule").Protect userinterfaceonly:=True

Application.ScreenUpdating = True

End Sub
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
One thing stands out - your Worksheet_Change code itself changes cells, which calls Worksheet_Change, which changes cells, which calls Worksheet_Change, and so on. When you have a need to do this, you should add Application.EnableEvents = False at the top and Application.EnableEvents = True at the bottom (presuming you don't have any Exit Sub statements that stop the second statement from being executed).
 
Upvote 0
Hi

Thanks for the suggestion. I'm sure this will improve performance but now the spreadsheet seems to be crashing as soon as I open it. I tried creating a new excel spreadsheet and writing some code from scratch and it just crashed again so now I'm wondering if it is the code?...(I know that is not a lot to go on)
 
Upvote 0
Wrote this in a new spreadsheet. It ran once then crashed.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Range("A4").Value = "Hello World"

End Sub
 
Upvote 0
Again, if you are going to code a Worksheet_Change event that itself changes cells, then you have produced an infinite loop. The Worksheet_Change calls itself endlessly, stack space gets exhausted, and Excel crashes. If you really want to say "Hello Word", then code it this way:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Range("A4").Value = "Hello World"
    Application.EnableEvents = True
End Sub
 
Upvote 0
Hi

That worked. Thanks

But it has never done this in the past when I've not put in this piece of code. Why is it breaking all of a sudden?

I tried changing it for the first spreadsheet and it continued to crash??

I think once I resolve the reason why it is still crashing, disabling the events will be a game changer for me. I've added this piece of code to my macros but not the event code itself. Not sure why I never thought of it before as it has been continually crashing on me.

Thanks. Appreciated
 
Upvote 0
Just to clarify things, Application.EnableEvents is vital in an event module which would otherwise trigger a call to that same module. So, in your case, you had an event that would be called whenever a change was made in its worksheet, but it was itself changing its worksheet, causing it to be called, when it would change things, causing it to be called, when it would change things, causing it to be called, ... and so on.

Without Application.EnableEvents, the only way that your previous coding for Worksheet_Change wouldn't have caused a crash would be if it didn't change anything in its worksheet. You could code anything else you like, and it would be okay, but as soon as you use the change event to change something, you have an infinite loop and a crash. That's why you set it to false - to disable events - before you change stuff, then set it to true after you've made your changes, so that it will be available for the next change that the user makes.
 
Upvote 0
I understand this but I've now implemented this and it is still crashing. I opened the initial file that I sent with this new piece of code then went to click save and it started to buffer instantly before crashing.
 
Upvote 0
1586259920052.png



This is the message i get now but I have hardly anything else open

1586259984756.png


And this is the task manager
 
Upvote 0
There could be a few reasons for the crashes. It's possible that you have other events (such as Workbook_BeforeSave) that we haven't discussed yet causing the crashes. It's possible that you are trying to manipulate too big an area instead of being selective. And so on.

A long way to track down what is happening is to go to the sub or function that starts things off, and press F8 repeatedly to track through the code until you find where (and hopefully why) it becomes unstable.

If it's a change event that is starting things, click on a line of code in the change event and press F9 to set a breakpoint, do whatever is necessary to invoke that event, then press F8 repeatedly to track through the code once the line with the breakpoint comes up.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

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