T
T
ti_zh_vrach2021-11-09 23:02:23
Visual Basic
ti_zh_vrach, 2021-11-09 23:02:23

Why does a macro in Excel break?

Good afternoon!
The search for an answer in Russian did not yield results. Searches in English did not give a result, probably due to poor knowledge of the language. I did not look beyond the 40th line in the search results.

The macro operation breaks at any time (or does not break) without any error messages on the same section of code. The problem is observed on both 32-bit and 64-bit (according to the end user) versions of Excel 2016.

The macro takes data from a file, enriches it through a request from the server, cuts it into 200-250 small xlsx files, writes to two summary files in parallel and sends everything to the recipients. The problem always occurs during cutting into files.

The code is like this:
Option Explicit
Sub macros_name()

Dim c As Integer
Dim i, j, o As Long
Dim some_code, small_file, file_total_data, created_file As String
Dim FSO, work_folder, work_file, dict_target, dict_another As Object
Dim l_inc_data, l_out As Workbook
'Как я узнал тут (https://qna.habr.com/q/1071426), _
часть переменных объявлена как Variant из-за перечисления через запятую.

Application.DisplayStatusBar = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False

Set FSO = CreateObject("Scripting.FileSystemObject")
Set work_folder = FSO.GetFolder(ThisWorkbook.Path)

On Error Resume Next
If l_input.AutoFilterMode Then l_input.ShowAllData
If l_main.AutoFilterMode Then l_main.ShowAllData
If l_data.AutoFilterMode Then l_data.ShowAllData
On Error GoTo 0

'Здесь забираются данные из файла. 10 колонок и около 2000 строк. Здесь всегда всё хорошо.

If Len(l_input.Cells(2, 1).Value) > 0 Then
    j = l_main.Cells(l_main.Rows.Count, 1).End(xlUp).Row + 1
    For i = 2 To l_input.Cells(l_input.Rows.Count, 1).End(xlUp).Row
        l_main.Cells(j, 8).NumberFormat = "@"
        l_main.Cells(j, 11).NumberFormat = "@"

        For c = 1 To 10
           l_main.Cells(j, c).Value = l_input.Cells(i, c).Value
        Next c
        
        some_code = add_data(args) 'тут функцию менял на ГСЧ - без толку.
        l_main.Cells(j, 11).Value = some_code
        If Len(l_main.Cells(j, 11).Value) > 0 _
        And dict_target(l_main.Cells(j, 11).Value) <> "no data" Then
            l_main.Cells(j, 12).Value = dict_another.Item(l_main.Cells(j, 11).Value)
            small_file = ThisWorkbook.Path & "\part_of_name" & some_code & " " & Date & ".xlsx"
            file_total_data = ThisWorkbook.Path & "\part_of_name" & l_main.Cells(j, 12).Value & " " _
                                      & Date & ".xlsx"
            'crate_new_file создаёт новый файл xlsx, делает заголовки колонок и закрывает файл.
            If Not FSO.FileExists(small_file) Then Call crate_new_file(small_file, False, row_log)
            If Not FSO.FileExists(file_total_data) Then Call crate_new_file(file_total_data, True, row_log)
            
            Set l_out = Application.Workbooks.Open(Filename:=small_file)
            o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
            
            For c = 1 To 10
                l_out.Sheets(1).Cells(o, c).Value = l_input.Cells(i, c).Value
            Next c
            
            l_out.Close True
            
            Set l_out = Application.Workbooks.Open(Filename:=file_total_data)
            o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
            
            For c = 1 To 10
                l_out.Sheets(1).Cells(o, c).Value = l_input.Cells(i, c).Value
            Next c
            
            l_out.Close True
        End If
        j = j + 1
    Next i
End If

'Здесь макрос делает остальные задачи. Тут тоже всегда всё хорошо.
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True

End Sub


What I tried: replacing the enriching function with a random number generator (see code), and transferring data from file to file using arrays.
In the latter case, the problem area looks like this:
....
Dim cells_to_copy As Range
....
If Len(l_input.Cells(2, 1).Value) > 0 Then
    j = l_main.Cells(l_main.Rows.Count, 1).End(xlUp).Row + 1
    For i = 2 To l_input.Cells(l_input.Rows.Count, 1).End(xlUp).Row
        l_main.Cells(j, 8).NumberFormat = "@"
        l_main.Cells(j, 11).NumberFormat = "@"

        Set cells_to_copy = l_input.Range(l_input.Cells(i, 1), l_input.Cells(i, 10))
        l_main.Range(l_main.Cells(j, 1), l_main.Cells(j, 10)).Value = cells_to_copy.Value

        some_code = add_data(args) 'тут функцию менял на ГСЧ - без толку.
        l_main.Cells(j, 11).Value = some_code
        If Len(l_main.Cells(j, 11).Value) > 0 _
        And dict_target(l_main.Cells(j, 11).Value) <> "no data" Then
            l_main.Cells(j, 12).Value = dict_another.Item(l_main.Cells(j, 11).Value)
            small_file = ThisWorkbook.Path & "\part_of_name" & some_code & " " & Date & ".xlsx"
            file_total_data = ThisWorkbook.Path & "\part_of_name" & l_main.Cells(j, 12).Value & " " _
                                      & Date & ".xlsx"
            If Not FSO.FileExists(small_file) Then Call crate_new_file(small_file, False, row_log)
            If Not FSO.FileExists(file_total_data) Then Call crate_new_file(file_total_data, True, row_log)
            
            Set l_out = Application.Workbooks.Open(Filename:=small_file)
            o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
            
            output_data.Sheets(1).Range( _
                              output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
                              ).NumberFormat = "@"
            output_data.Sheets(1).Range( _
                              output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
                              ).Value = copied_data.Value
            
            l_out.Close True
            Set l_out = Nothing
            
            Set l_out = Application.Workbooks.Open(Filename:=file_total_data)
            o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
            
            output_data.Sheets(1).Range( _
                              output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
                              ).NumberFormat = "@"
            output_data.Sheets(1).Range( _
                              output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
                              ).Value = copied_data.Value
            
            l_out.Sheets(1).Cells(o, 11).Value = some_code
            l_out.Close True
            Set l_out = Nothing
        End If
        Set cells_to_copy = Nothing
        j = j + 1
    Next i
End If

In both cases, Excel (32 bit) runs for the same amount of time (if it doesn't crash) and quickly takes up about 600 MB of RAM. After closing the file, the Excel process hangs for a long time and slowly reduces the occupied RAM. It might take an hour. This happens both if it is interrupted, and if it is finalized. In the event of a break, one of the small files always remains open. In this case, the data is always already written to l_main (leaf of the file with the macro), but not yet written to the small file.

What could be the problem and how to deal with it?

UPD: with Excel x64 there are no problems with RAM. Breaks occur especially if you talk on Skype or watch mail in Outlook.

Answer the question

In order to leave comments, you need to log in

1 answer(s)
A
Anton, 2021-11-15
@ti_zh_vrach

As what first caught my eye
- perhaps swears at too long paths of newly created files.
- remove On Error GoTo 0 and see where to stop.
- add DoEvents "accidentally" scattered throughout the code.
- describe _all_ variables, perhaps something unexpected appears somewhere in them, Variant is quite insidious.

Didn't find what you were looking for?

Ask your question

Ask a Question

731 491 924 answers to any question