"Microsoft Excel has stopped working" error

[Mihael]

Whenever I run a certain macro, it gives me an error that says "Microsoft Excel has stopped working" (see picture underneath). The macro finishes to the end, but then I get this error. Does anyone know about this error and how I can prevent this error?

 

[Joe4]

A lot of it may depend on exactly what your code is doing. Your code may be using too many resources and testing the limits of your computer.
You may need to post your code here so we can analyze it, and maybe help make it leaner so it doesn't do that.

 

[Mihael]

Hi, see the following code. At the end line "Application.Quit" it gives me the error.

Private WithEvents App As Application
Private Sub Workbook_Open()
    Set App = Application
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
 Dim Matnr As String
 Dim Batchnr As String
 Dim batchvolg As String
 Dim Partname As String
 Dim Year As String
 Set Sht = Wb.ActiveSheet
 Dim FldrPth As String
 Dim Fname As String
 Dim Wbk As Workbook
 Dim Awb As String
 Dim fdObj As Object
   
Application.ScreenUpdating = False
Application.DisplayAlerts = False
  
'The macro runs only when the name of the workbook is equal to "EXCEL_OMZET_SHEET##" AND the value in cell C4 is equal to "frontside" or "backside"
'Frontside If Statements
    If UCase(Wb.Name) Like "EXCEL_OMZET_SHEET#.XLS" Or _
        UCase(Wb.Name) Like "EXCEL_OMZET_SHEET##.XLS" Then
   
        If LCase(Wb.ActiveSheet.Range("C4").Value) = "frontside" Then
 
            Awb = ActiveWorkbook.Name
            batchvolg = Range("C12")
            Partname = Range("C3")
            Matnr = Left(Range("C3").Value, 8)
            Batchnr = Left(Range("C12").Value, 12)
            Year = Right(Range("C8").Value, 4)
            
            'Create the directory to save the frontside of the pallet measurement and save in the directory
            Set fdObj = CreateObject("Scripting.FileSystemObject")
            If fdObj.FolderExists("J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\" & Matnr & "\pallet") Then
            
            Else
            fdObj.CreateFolder ("J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\" & Matnr & "\pallet")
            End If
            
            ActiveWorkbook.SaveAs "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\" & Matnr & "\pallet\" & Partname & "_" & batchvolg & ".xls", FileFormat:=xlNormal
           
            Application.Quit
            
        End If
    End If
'Backside If statements
If UCase(Wb.Name) Like "EXCEL_OMZET_SHEET#.XLS" Or _
    UCase(Wb.Name) Like "EXCEL_OMZET_SHEET##.XLS" Then
   
    If LCase(Wb.ActiveSheet.Range("C4").Value) = "backside" Then
        Awb = ActiveWorkbook.Name
        batchvolg = Range("C12")
        Partname = Range("C3")
        Matnr = Left(Range("C3").Value, 8)
        Batchnr = Left(Range("C12").Value, 12)
        Year = Right(Range("C8").Value, 4)
        FldrPth = "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\" & Matnr & "\pallet\" & Partname & "_" & batchvolg & ".xls"
        Set Wbk = Workbooks.Open(FldrPth)
        Fname = Partname & "_" & batchvolg & ".xls"
        
        If Wbk Is Nothing Then
            MsgBox Fname & "niet gevonden in directory " & FldrPth
            Exit Sub
        End If
        
        ' Merge the backside in the frontside measuring report
        With Wbk.Sheets("Bericht1_Seite1")
        Sht.Range("B20:R" & Sht.Range("B" & Sht.Rows.Count).End(xlUp).Row).Copy .Range("B" & Sht.Rows.Count).End(xlUp).Offset(1)
    
        End With
        Wbk.Save
        Wb.Close False
   
        ' Call the sub "Klantrapport"
        Call Klantrapport
        
        Kill "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\" & Matnr & "\pallet\" & Partname & "_" & batchvolg & ".xls"
                
        Application.Quit
                
                
    End If
End If
End Sub

The Call Klantrapport macro is:

Sub Klantrapport()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Dim Matnr As String
    Dim Batchnr As String
    Dim batchvolg As String
    Dim Partname As String
    Dim Year As String
    Dim Awb As String 'Hexagon
    Dim Nwb As String
    Dim HMF As String  'Hexagon moederfile
    Dim Temp As String 'excel template
    Dim WTemp As Workbook
    Dim Macro As String
'Huidige werkbook wordt Awb en definitie batch, materiaal nrs
    Awb = ActiveWorkbook.Name
        batchvolg = Range("C12")
        Partname = Range("C3")
        Matnr = Left(Range("C3").Value, 8)
        Batchnr = Left(Range("C12").Value, 12)
        Year = Right(Range("C8").Value, 4)
 
    Filename = "J:\Kwaliteit Helmond\Hexagon\Optiv_3\" & Matnr & "_ep.xls"
 
    Workbooks.Open Filename
HMF:
    Nwb = ActiveWorkbook.Name
        Workbooks(Awb).Activate
        Cells.Select
        Application.CutCopyMode = False
        Selection.Copy
        Workbooks(Nwb).Activate
        Sheets("Hexagon").Select
        Cells.Select
        ActiveSheet.Paste
        
        'Autofit en hiden kolommen die niet gebruikt worden
        'Range("A:A,E:E,F:F,K:K,N:N,O:O,P:P,Q:Q,R:R,S:S,T:T,U:U,V:V").Select
        'Range("V1").Activate
        'Selection.EntireColumn.Hidden = True
        Columns("B:B").EntireColumn.AutoFit
        'Columns("C:C").EntireColumn.AutoFit
        'Columns("D:D").EntireColumn.AutoFit
        Columns("E:E").EntireColumn.AutoFit
        Columns("F:F").EntireColumn.AutoFit
        Columns("G:G").EntireColumn.AutoFit
        Columns("H:H").EntireColumn.AutoFit
        Columns("I:I").EntireColumn.AutoFit
        Columns("J:J").EntireColumn.AutoFit
        Columns("G:G").EntireColumn.AutoFit
        Columns("L:L").EntireColumn.AutoFit
        Columns("M:M").EntireColumn.AutoFit
        Columns("N:N").EntireColumn.AutoFit
        Columns("O:O").EntireColumn.AutoFit
        Columns("P:P").EntireColumn.AutoFit
        Columns("Q:Q").EntireColumn.AutoFit
        Columns("R:R").EntireColumn.AutoFit
       
        Range("A1").Select
        Application.CutCopyMode = False
        
        Workbooks(Awb).Activate
        Range("A1").Select
        ActiveWorkbook.Close
                     
        Workbooks(Nwb).Activate
        FilePath = ""
        On Error Resume Next
        FilePath = Dir("J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\" & Matnr & "\")
        On Error GoTo 0
        If FilePath = "" Then
            MkDir "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\" & Matnr & "\"
        End If
    ActiveWorkbook.SaveAs "J:\Kwaliteit Helmond\FINAL INSPECTION REPORTS\" & Year & "\" & Matnr & "\" & Partname & "_" & batchvolg & ".xls", FileFormat:=xlNormal
    
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
    
End Sub

 

[Joe4]

You have some Application.Quit and some Kill statements in there, so I guess it is not overly surprising that could be happening.
Have you tried to step through your code to see exactly where in the process that message pops-up?
That should give you some insight regarding which lines of code you want to focus on.

 

[Mihael]

I tested it on an offline station and this macro works, however, the macro needs to perform on a computer which is attached to a machine. This machines software demands a lot of the computers capacity. Could this be the problem?

 

[Joe4]

It certainly could be. If it works offline without errors, that suggests that the macro itself is fine.
I would suspect the issue might be the environment you have and the resources that the machine is hogging.

 

[Jon Peltier]

Which Application.Quit is associated with the crash? I suspect the code might be trying to quit before either the workbook is finished saving (first instance) or the file is finished being deleted (second instance).

Insert the line "DoEvents" before Application.Quit, and see if that helps.

 

[Mihael]

It is in the first code at the end after the Call Klantrapport, kill file. I just have to place the function DoEvents in the line above Application.Quit?

 

[Jon Peltier]

That's right. It might not fix the problem, but sometimes it helps with similar timing issues.

If you step through the code, does the error occur? Put a breakpoint on the line after Call Klantrapport, then use F8 to step through the rest of the code.

 

[Mihael]

I placed DoEvents after Application.Quit and I did not get the message. Thanks for the help!