Home > Software engineering >  Excel crashing randomly when running macro
Excel crashing randomly when running macro

Time:03-15

I'm having an issue with the following code, that is supposed to sequentially open 〜100 csv files, check for a value in a cell (validation, if it is file with correct structure), copy single line of data and paste it into ThisWorkbook.Worksheets("2 CSV").Range("B" & row_number).

This solution worked for two years until this month. Now the whole Excel crashes randomly on any file without any error message. Sometimes it manages to loop through 20 files, sometimes 5.

The weirdest thing is, that I can loop manually using F8 through the whole thing without any problem.

The macro:

Sub b_load_csv()

Dim appStatus           As Variant
Dim folder_path         As String       'folder path to where CSVs are stored
Dim file_name           As String       'file name of current CSV file
Dim row_number          As Integer      'row number in target sheet
Dim source_sheet_name   As String       'name of the source sheet of the CSV = CSV file name
Dim wb_src              As Workbook     'variable for opened CSV source workbook
Dim sht_src             As Worksheet    'variable for opened CSV source sheet
Dim sht_csv             As Worksheet    'variable for target sheet in ThisWorkbook

With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
    If .StatusBar = False Then appStatus = False Else appStatus = .StatusBar 'show currently processing file in status bar
End With

folder_path = "C:\Folder\SubFolder\"            'here are the files stored
file_name = Dir(folder_path & "*.csv")          'using dir to get file names
row_number = 3                                  'row number for pasting values
Set sht_csv = ThisWorkbook.Worksheets("2 CSV")  'target sheet for data aggregation

Do While file_name <> ""
    Workbooks.Open (folder_path & file_name), UpdateLinks:=False, Local:=True   'open csv file
    Set wb_src = Workbooks(file_name)                                           'assign opened csv file to variable
    source_sheet_name = Left(file_name, InStr(file_name, ".") - 1)              'sheet name in csv is the same as the file name
    Set sht_src = wb_src.Worksheets(source_sheet_name)                          'assign source sheet to variable
    
    If sht_src.Range("C1").Value2 = "OJ_POPIS" Then     'checks if the csv has the correct structure
        sht_src.Range("A2:FZ2").Copy                    'if so copies desired range
        sht_csv.Range("B" & row_number).PasteSpecial    'and pastes it into target worksheet column B
    End If
    
    sht_csv.Range("A" & row_number).Value2 = file_name  'writes file name into column A
    Application.CutCopyMode = False
    wb_src.Close SaveChanges:=False
    file_name = Dir()   'fetch next file name
    row_number = row_number   1
    
    'the following lines is what I tried to fix the problem of random excel crashing
    Set wb_src = Nothing
    Set sht_src = Nothing
    Application.StatusBar = "Processing file " & file_name
    DoEvents
    Application.Wait (Now   TimeValue("0:00:02"))
    ThisWorkbook.Save 'save after every loaded file to see which files are causing the problem
Loop

MsgBox "Data from CSV files copied", vbOKOnly

Set sht_csv = Nothing

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Source CSV files are encoded both in UTF-8 and ANSI (my ACP is ANSI, 1250) and ; delimited.

Group policy restricting macros doesn't apply to me. I can sign my own macros.

What I tried:

  • Lines of code at the end of the loop
  • Identifying and deleting files triggering the crash (they have nothing in common, seemingly random, by the time a remove half of them... what is the point)
  • Simplifying the macro
  • New workbook
  • Different machine
  • VPN On/Off

Thank you for your help!

CodePudding user response:

First thing I'd try is include a proper error handler (not resume next), particularly with x64, and ensure 'Break on all unhandled errors' is selected in Tools / Options / General.

Second thing I'd try is avoid using the clipboard -

With sht_src.Range("A2:FZ2")
    sht_cvs.Range("B" & row_number).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

(no need then to clear CutCopyMode)

Third thing I'd try is don't filter with Dir but something like this -

sFilter = "*.cvs"
file_name = Dir$(, 15)    ' without vbDirectory if not getting subfolders
Do While Len(file_name)
    If file_name Like sFilter Then
        ' process file
    End If
    file_name = Dir$(, 15)
Loop

Fourth thing I'd try is a good cup of coffee!

  • Related