Msgbox Crashing Excel Randomly

Question

Background

I have had this problem in many machines, different excel configurations and not linked to a specific code.
I like to provide users with a message box at the end of the code execution, like a "OK01: Performed succesfully!"

Problem

The messagebox crashes Excel instance randomly. There is no real way to debug it since when it is debugged it works as expected, but it only happens on random occasions: could be on the first run, after the second, on the fifth, on the tenth, etc; Programs on memory are the same or as many as possible to be closed; Excel instance with just one file opened or mutiple. Let us say, multiple common scenarios for a PC.

Considerations

Files are created from scratch, not even module import happens. Whenever I do a macro I use the following structure. It happens either if Call ExcelNormal is before or after the MessageBox; it happens even if it is the only messagebox on the execution too.

Code

Sub Sample()
If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub
Call ExcelBusy
Call Exec_CreateSheets("Sheet2")
Call Exec_ImportExcelFile("Dummy", Sheets(1).Range("A1"), True, True, True, "Sheet1", TxtPathForFile:="C:\Users\UserName\Desktop\Testfile.xlsx")
MsgBox "Ok01Exec_RoutinesToRun: Done!", vbOKOnly
Call ExcelNormal
End Sub
Sub ExcelNormal()
With Excel.Application
.Cursor = xlDefault
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
.AskToUpdateLinks = True
.StatusBar = False
.EnableEvents = True
End With
End Sub
Sub ExcelBusy()
With Excel.Application
.Cursor = xlWait
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
.AskToUpdateLinks = False
.StatusBar = False
.EnableEvents = False
End With
End Sub
Function Return_IsExcelFileLocked(ByVal TxtFile As String) As Boolean
On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open TxtFile For Binary Access Read Write Lock Read Write As #1
Close #1
' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
' Display the error number and description.
MsgBox "Error01Return_IsExcelFileLocked: #" & Str(Err.Number) & " - " & Err.Description & ": If file is open please close it."
Return_IsExcelFileLocked = True
Err.Clear
End If
End Function
Sub Exec_ImportExcelFile(ByVal TxtSheetToCreate As String, ByVal RangeDataBegins As Range, ByVal IsNeededAsValuesOnly As Boolean, ByVal IsPartOfSubs As Boolean, ByVal IsImportedSheetVisible As Boolean, Optional ByVal TxtSheetToImport As String, Optional ByVal IsImportedFileNeededToBeDeleted As Boolean, Optional ByVal TxtPathForFile As String)
Dim WBToImport As Workbook
Dim WBOriginal As Workbook
Dim TxtFileToImport As String
Dim VarValueFromMsg As Variant
If TxtPathForFile = "" Then ' 2. If TxtPathForFile = ""
MsgBox "War01Exec_ImportExcelFile: If the file for the " & TxtSheetToCreate & " is opened, please close it before importing", vbExclamation
VarValueFromMsg = Application.GetOpenFilename(Title:="Please choose the " & TxtSheetToCreate & " file", fileFilter:=TxtSheetToCreate & " (*.xls;*.xlsx;*.xlsm;*.csv),*.xls;*.xlsx;*.xlsm;*.csv", ButtonText:=TxtSheetToCreate, MultiSelect:=False)
On Error GoTo Err01Exec_ImportExcelFile
If VarValueFromMsg = False Then Call ExcelNormal: End
Err01Exec_ImportExcelFile:
Else ' 2. If TxtPathForFile = ""
VarValueFromMsg = TxtPathForFile
End If ' 2. If TxtPathForFile = ""
If IsPartOfSubs = False Then Call ExcelBusy
Set WBOriginal = ThisWorkbook
TxtFileToImport = CStr(VarValueFromMsg)
If Return_IsExcelFileLocked(TxtFileToImport) = True Then Call ExcelNormal: End
Call Exec_CreateSheets(TxtSheetToCreate)
On Error GoTo Err02Exec_ImportExcelFile
Set WBToImport = Workbooks.Open(Filename:=TxtFileToImport, ReadOnly:=True)
If TxtSheetToImport = "" Then TxtSheetToImport = WBToImport.ActiveSheet.Name
Call Exec_ShowAllDataInSheet(TxtSheetToImport, WBToImport)
With WBToImport
Application.CutCopyMode = False
If IsNeededAsValuesOnly = True Then ' 1. If IsNeededAsValuesOnly = True
.Sheets(TxtSheetToImport).Range(.Sheets(TxtSheetToImport).Cells(RangeDataBegins.Row, RangeDataBegins.Column), .Sheets(TxtSheetToImport).Cells(.Sheets(TxtSheetToImport).Cells.SpecialCells(xlCellTypeLastCell).Row, .Sheets(TxtSheetToImport).Cells.SpecialCells(xlCellTypeLastCell).Column)).Copy
'.Sheets(TxtSheetToImport).Range(.Sheets(TxtSheetToImport).Cells(RangeDataBegins.Row, RangeDataBegins.Column), .Sheets(TxtSheetToImport).Cells(.Sheets(TxtSheetToImport).Cells.SpecialCells(xlCellTypeLastCell).Row, .Sheets(TxtSheetToImport).Cells.SpecialCells(xlCellTypeLastCell).Column)).Copy
WBOriginal.Sheets(TxtSheetToCreate).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else ' 1. If IsNeededAsValuesOnly = True
.Sheets(TxtSheetToImport).Range(RangeDataBegins.Address).CurrentRegion.Copy Destination:=WBOriginal.Sheets(TxtSheetToCreate).Cells(1, 1)
End If ' 1. If IsNeededAsValuesOnly = True
End With
WBToImport.Close False, False
DoEvents
Application.CutCopyMode = False
If IsImportedFileNeededToBeDeleted = True Then Kill (VarValueFromMsg)
WBOriginal.Activate
Sheets(TxtSheetToCreate).Visible = IsImportedSheetVisible
DoEvents
'trying to address memory leaks when called by subs
Set WBToImport = Nothing: Set WBOriginal = Nothing
If IsPartOfSubs = False Then Call ExcelNormal
If 1 = 2 Then ' 99. If error
Err02Exec_ImportExcelFile:
MsgBox "Err02Exec_ImportExcelFile: Excel could not find the file at '" & TxtFileToImport & "'. Make sure the file exists!" & Chr(10) & "Further Details: " & Err.Description, vbCritical: Call ExcelNormal: End
End If ' 99. If error
End Sub
Sub Exec_ShowAllDataInSheet(ByVal TxtSheet As String, Optional ByVal WBParent As Workbook)
If WBParent Is Nothing Then Set WBParent = ThisWorkbook
On Error GoTo Err01Exec_ShowAllDataInSheet
WBParent.Sheets(TxtSheet).Visible = True
On Error Resume Next
WBParent.Sheets(TxtSheet).ShowAllData
WBParent.Sheets(TxtSheet).EntireRow.Hidden = False
WBParent.Sheets(TxtSheet).EntireColumn.Hidden = False
'trying to address memory leaks when called by subs
Set WBParent = Nothing
If 1 = 2 Then ' 99. If error
Err01Exec_ShowAllDataInSheet:
MsgBox "Err01Exec_ShowAllDataInSheet: Sheet " & TxtSheet & " does not exists!", vbCritical: Call ExcelNormal: End
End If ' 99. If error
End Sub
Sub Exec_CreateSheets(ByVal NameSheet As String, Optional ByVal Looked_Workbook As Workbook)
If Looked_Workbook Is Nothing Then Set Looked_Workbook = ThisWorkbook
Dim SheetExists As Worksheet
On Error GoTo ExpectedErr01CreateSheets
Set SheetExists = Looked_Workbook.Worksheets(NameSheet)
SheetExists.Delete
ExpectedErr01CreateSheets:         'this means sheet didn't existed so, we are going to create it
With Looked_Workbook
.Sheets.Add After:=.Sheets(.Sheets.Count)
ActiveSheet.Name = NameSheet
'trying to address memory leaks when called by subs
Set Looked_Workbook = Nothing
End With
End Sub

There is no real consistent code that provokes this behaviour, so I insert an image to ilustrate it.

Question

I am not quite sure if a UserForm instead will address it, I am suspecting on some memory issue related to show the messagebox; is there a way to clean it somehow or to prevent his behaviour? I have tried to look for documentation in this regard but I have not found anything to this specific scenario.

Based on Cristian Buse Solution

I changed the End on the first message box but having the same results. I found a way for others to reproduce the behaviour, I edited my original code.

By logging "Manually" I am still unable to get a log on what is happening (although as I stated on comments, my guess as now is that it tries to display "out of memory" and crashes), I share my findings by using this neat solution

Log when crashed first run
[2021-11-05 11:43:17][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:19][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:27][Before messagebox] Before messagebox
[2021-11-05 11:43:27][ConsoleLog] 
Log when crashed on 7th run (as I said, it could happen on the nth run, the most annoying one is the first one)
[2021-11-05 11:43:32][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:33][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:35][Before messagebox] Before messagebox
[2021-11-05 11:43:35][ConsoleLog] 
[2021-11-05 11:43:35][ExcelNormal] 
[2021-11-05 11:43:36][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:38][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:39][Before messagebox] Before messagebox
[2021-11-05 11:43:39][ConsoleLog] 
[2021-11-05 11:43:39][ExcelNormal] 
[2021-11-05 11:43:40][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:41][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:43][Before messagebox] Before messagebox
[2021-11-05 11:43:43][ConsoleLog] 
[2021-11-05 11:43:43][ExcelNormal] 
[2021-11-05 11:43:44][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:45][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:47][Before messagebox] Before messagebox
[2021-11-05 11:43:47][ConsoleLog] 
[2021-11-05 11:43:47][ExcelNormal] 
[2021-11-05 11:43:48][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:49][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:50][Before messagebox] Before messagebox
[2021-11-05 11:43:50][ConsoleLog] 
[2021-11-05 11:43:50][ExcelNormal] 
[2021-11-05 11:43:51][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:52][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:54][Before messagebox] Before messagebox
[2021-11-05 11:43:54][ConsoleLog] 
[2021-11-05 11:43:54][ExcelNormal] 
[2021-11-05 11:43:55][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:56][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:57][Before messagebox] Before messagebox
[2021-11-05 11:43:57][ConsoleLog]

Basically when ConsoleLog ends on the last line is when it crashed, to be clear, on the first log it crashed on the 1st run for the code [2021-11-05 11:43:27][ConsoleLog] and on the second log crashed after the 7th run on the line [2021-11-05 11:43:57][ConsoleLog].

Sub Sample()
    If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub
    Call ExcelBusy
    Call Exec_CreateSheets("Sheet2")   
    LogTextToFile "Exec_CreateSheets", "Before calling ExcelBusy"
    Call Exec_ImportExcelFile("Dummy", Sheets(1).Range("A1"), True, True, True, "Sheet1", TxtPathForFile:="C:\Users\UserName\Desktop\Testfile.xlsx")
    LogTextToFile "Exec_ImportExcelFile", "After Importing Excel"
    LogTextToFile "Before messagebox", "Before messagebox"
    LogTextToFile "ConsoleLog", Err.Description
    MsgBox "Ok01Exec_RoutinesToRun: Done!", vbOKOnly
    Call ExcelNormal
    LogTextToFile "ExcelNormal", Err.Description
End Sub

user_8488913 · Answer

First of all you should not use End on it's own. It clears the whole state (all variables lose value throughout the project) and might just be the cause of all your issues. Instead use Exit Sub or Exit Function. Replace:

If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then End

with:

If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub

If that does not fix your issue then the following code will help you with debugging:

Option Explicit

'Rudimentary Logging
Const LOG_FILE_PATH As String = "C:\Users\\Desktop\RudLog.txt"


Public Sub LogTextToFile(ByVal procName As String, ByVal textToLog As String)
    Dim fileNumber As Long: fileNumber = FreeFile
    '
    On Error Resume Next
    Open LOG_FILE_PATH For Append Access Write Lock Write As fileNumber
    Print #fileNumber, "[" & Format$(Now(), "yyyy-mm-dd hh:mm:ss") & "][" & procName & "] " & textToLog
    Close fileNumber
    On Error GoTo 0
End Sub

Public Sub ClearLogFile()
    Dim fileNumber As Long: fileNumber = FreeFile
    '
    On Error Resume Next
    Open LOG_FILE_PATH For Output Access Write Lock Write As fileNumber
    Close fileNumber
    On Error GoTo 0
End Sub

Just replace the LOG_FILE_PATH value with a valid path. The text file name can be anything. The file will be created for you as long as the folder is valid and there are valid characters in the file name.

Your Sample procedure can then become:

Sub Sample()
    If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub
    LogTextToFile "Sample", "Before calling ExcelBusy"
    Call ExcelBusy
    LogTextToFile "Sample", "After calling ExcelBusy"
    'code
    LogTextToFile "Sample", "Before MsgBox"
    MsgBox "Ok01Exec_RoutinesToRun: Done!", vbOKOnly
    LogTextToFile "Sample", "After MsgBox"
    'code
    LogTextToFile "Sample", "Before calling ExcelNormal"
    Call ExcelNormal
    LogTextToFile "Sample", "After calling ExcelNormal"
End Sub

On my computer, the above write the following to the text file:

[2021-11-05 09:05:56][Sample] Before calling ExcelBusy
[2021-11-05 09:05:56][Sample] After calling ExcelBusy
[2021-11-05 09:05:56][Sample] Before MsgBox
[2021-11-05 09:05:57][Sample] After MsgBox
[2021-11-05 09:05:57][Sample] Before calling ExcelNormal
[2021-11-05 09:05:59][Sample] After calling ExcelNormal

Of course, you can add as many logging lines in the other methods to see exactly what is the last line that works before crashing.

Edit #1

As suggested by @Ike in the comments section, long lines of code impact readability and make issues harder to spot.

A good replacement for:

If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub

could be:

Dim res As VbMsgBoxResult
res = MsgBox(Prompt:="Please confirm that you want to run the following code" _
           , Buttons:=vbYesNo _
           , Title:="Please confirm")
If res = vbNo Then Exit Sub

or even:

If MsgBox(Prompt:="Please confirm that you want to run the following code" _
        , Buttons:=vbYesNo _
        , Title:="Please confirm") = vbNo Then Exit Sub

Msgbox Crashing Excel Randomly

1 Answers