Macro memory problems… Maybe?

P

PeterTaylor

Board Regular
Joined
Aug 5, 2010
Messages
158
Dear all,
I am running Excel 2013 on Windows 7.
I have the following macro, it opens a text file, looks for certain elements, and reports its findings to a spreadsheet.
Code: 
 Sub checkfiles()
    Dim mCol, mRow, mydata, myCount, myRowCount As Long
    Dim counter, myversion, mySave As Integer
    Dim vstring As String
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set wbWorkingList = ActiveWorkbook
    
mySave = 1
  For Each MyList In wbWorkingList.Sheets("IMPORTLIST").Range("A:A").SpecialCells(xlCellTypeConstants)


                    Application.Workbooks.OpenText MyList.Value, origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
                    Comma:=True, Space:=True, Other:=False
            Set wbText = ActiveWorkbook
                    
            Set found = wbText.Sheets(1).Columns("A").Find("H1000", , xlFormulas, xlWhole)
    
            If found Is Nothing Then
                'Set found = wbText.Sheets(1).Columns("A").Find("H01000", , xlFormulas, xlWhole)
               'If found Is Nothing Then
               With wbWorkingList.Sheets("Bad File").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .Value = MyList.Value
                    .Offset(, 1).Value = "No H1000"
                    GoTo myNextfile
                End With
                'End If
            Else
            'On Error GoTo point1
                        wbText.Sheets(1).Columns("A").Find("H1000", , xlFormulas, xlWhole).Activate
                        mydata = ActiveCell.Row
                        'GoTo point2
'point1:
                        'Resume Next
                        'wbText.Sheets(1).Columns("A").Find("H01000", , xlFormulas, xlWhole).Activate
                        'mydata = ActiveCell.Row
'point2:
                        wbText.Sheets(1).Range(Cells(mydata, 2), Cells(mydata, wbText.Sheets(1).UsedRange.Columns.Count)) _
                        .Copy Destination:=wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp).Offset(1).Offset(, 18)
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .Value = MyList.Value
                    .Offset(, 11).Value = "OK"
                    '.Offset(, 19).Value = wbtext.Sheets(1).Range(Cells(mydata, 2), Cells(mydata, wbtext.Sheets(1).UsedRange.Columns.Count))
               End With

            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0104", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 1).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 1).Value = "OK"
               End With
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0105", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 2).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 2).Value = "OK"
               End With
            End If
            
 
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0150", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 3).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 3).Value = "OK"
               End With
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0151", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 4).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 4).Value = "OK"
               End With
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0200", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 5).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 5).Value = "OK"
               End With
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0202", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 6).Value = "No"
               End With
          
            
            Else
                wbText.Sheets(1).Columns("A").Find("H0202", , xlFormulas, xlWhole).Activate
                counter = 1
                mCol = ActiveCell.Column
                mCol = mCol + 2
                mRow = ActiveCell.Row
                vstring = vbNullString
                'Concatenate the next 10 cells in the row
                While counter < 11
                    vstring = WorksheetFunction.Trim(vstring & " " & wbText.Sheets(1).Cells(mRow, mCol).Value)
                    counter = counter + 1
                    mCol = mCol + 1
                Wend
                'myversion = Val(vstring)
               
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 6).Value = vstring 'myversion
               End With
            
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0501", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 7).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 7).Value = "OK"
               End With
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0503", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 8).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 8).Value = "OK"
               End With
            End If
            Set found = wbText.Sheets(1).Columns("A").Find("H0504", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 9).Value = "No"
               End With
            
            Else
                wbText.Sheets(1).Columns("A").Find("H0504", , xlFormulas, xlWhole).Activate
                counter = 1
                mCol = ActiveCell.Column
                mCol = mCol + 2
                mRow = ActiveCell.Row
                vstring = vbNullString
                
                'Concatenate the next 10 cells in the row
                While counter < 11
                    If IsNumeric(wbText.Sheets(1).Cells(mRow, mCol).Value) Then
                        vstring = WorksheetFunction.Trim(vstring & " " & CStr(wbText.Sheets(1).Cells(mRow, mCol).Value))
                    End If
                    vstring = WorksheetFunction.Trim(vstring & " " & wbText.Sheets(1).Cells(mRow, mCol).Value)
                    counter = counter + 1
                    mCol = mCol + 1
                Wend
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 9).Value = vstring
               End With
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H0531", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 10).Value = "No"
               End With
            
            Else
               wbText.Sheets(1).Columns("A").Find("H0531", , xlFormulas, xlWhole).Activate
                counter = 1
                mCol = ActiveCell.Column
                mCol = mCol + 2
                mRow = ActiveCell.Row
                vstring = vbNullString
                
                'Concatenate the next 10 cells in the row
                While counter < 11
                    If IsNumeric(wbText.Sheets(1).Cells(mRow, mCol).Value) Then
                        vstring = WorksheetFunction.Trim(vstring & " " & CStr(wbText.Sheets(1).Cells(mRow, mCol).Value))
                    End If
                    vstring = WorksheetFunction.Trim(vstring & " " & wbText.Sheets(1).Cells(mRow, mCol).Value)
                    counter = counter + 1
                    mCol = mCol + 1
                Wend
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 10).Value = vstring
               End With
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("H1001", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 12).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 12).Value = "OK"
               End With
            End If
            Set found = wbText.Sheets(1).Columns("A").Find("H1002", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 13).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 13).Value = "OK"
               End With
            End If
            Set found = wbText.Sheets(1).Columns("A").Find("H1003", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 14).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 14).Value = "OK"
               End With
            End If
            Set found = wbText.Sheets(1).Columns("A").Find("H1004", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 15).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 15).Value = "OK"
               End With
            End If
            Set found = wbText.Sheets(1).Columns("A").Find("D", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 16).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 16).Value = "OK"
               End With
            End If
            
            Set found = wbText.Sheets(1).Columns("A").Find("EOF", , xlFormulas, xlWhole)
            If found Is Nothing Then
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 17).Value = "No"
               End With
            
            Else
               With wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp)
                    .Offset(, 17).Value = "OK"
               End With
            End If
myNextfile:
            mySave = mySave + 1
            wbText.Close
            If mySave = 20 Then
                wbWorkingList.Save
                mySave = 1
            End If
            Next MyList
           
     Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    wbWorkingList.Save
   MsgBox ("fin")
   End Sub
The code seems to work fine. However, after it is processed 210 files I get the following error:
access violation at address 76f78e19 in module ntdll.dll. Write address of 00000014. Or a message telling me that I don't have enough memory. If I ex it Excel then reopen I can run the process again for a further 210 files. After a search of the web I have found out that Excel seems to not release its memory properly when opening and closing workbooks. Is this the case? Since I have about 6000 files to examine is there a workaround for this problem? Or is there another approach that I can use to examine of these files.
Regards,
Peter.
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
Without going through all the code
Try cancelling all of your sets to nothing
So, before the line Next Mylist, put

Code: 
set found= nothing
Set WbText = nothing
 
Upvote 0
PeterTaylor,

If I understand your macro code correctly:


It would appear that you are not releasing/clearing the memory buffer after each copy.


The following is worth a try on a copy of your workbook:


You are copying data here:

Code: 
'************************
'point2:
                        wbText.Sheets(1).Range(Cells(mydata, 2), Cells(mydata, wbText.Sheets(1).UsedRange.Columns.Count)) _
                        .Copy Destination:=wbWorkingList.Sheets("Good Files").Range("A" & Rows.Count).End(xlUp).Offset(1).Offset(, 18)
               
'************************




Try adding the next line of code, it will clear the memory buffer:

Code: 
'************************
            
myNextfile:
            mySave = mySave + 1
            wbText.Close
            If mySave = 20 Then
                wbWorkingList.Save
                mySave = 1
            End If

                        
            '********** the next line of code will clear the memory buffer **********

            [B][SIZE=3]Application.CutCopyMode = False[/SIZE][/B]

            
            Next MyList
           
'************************
 
Upvote 0
Michael M said:
Without going through all the code
Try cancelling all of your sets to nothing
So, before the line Next Mylist, put

Code: 
set found= nothing
Set WbText = nothing
Click to expand...

Dear Michael,
I have been battling with this code all day, your suggestions offered some hope but there were some or underlying problems with the code that I haven't yet tracked down. It would seem that the addition of this code helps as it will allow the process up to 600 files in one macro. At present at file number 214 the found statement stays at nothing and the program is rejecting "good files". I will continue to chase this down tomorrow and if I have any success I will let you know.
Thanks again for your assistance.
Regards,
Peter
 
Upvote 0
Dear hiker 95,
thanks for the suggestion, I tried this addition of code with the same macro are referred to in Michael W reply. The process worked but gave the "access violation" error message at the end of the process. The sets found statement gets stuck in "nothing" at file number 214. There is nothing obviously wrong with this file and all subsequent files are flagged as "bad files" erroneously by the macro. I'm going to have to investigate this further with some watch points etc in the morning. Thanks for your help. If I have any developments/breakthroughs I will let you know.
Regards,
Peter
 
Upvote 0
PeterTaylor,

Thanks for the feedback.

Sorry that my changes/additions did not work.


You may want to try:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.
 
Upvote 0
hiker95 said:
PeterTaylor,

Thanks for the feedback.

Sorry that my changes/additions did not work.


You may want to try:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.
Click to expand...

Bump
 
Upvote 0
PeterTaylor said:
Bump
Click to expand...

Dear all,
there has been a development with this problem that I thought I might share. Below is a variant of the code in the original problem; it essentially does the same thing but with less "set" statements.
Code: 
Sub list_fieldnames()
Dim loopCount As Integer

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

Set wbWorkingList = Workbooks.Open(Filename:="C:\Tools\FilestobeProcessed.xlsm")
loopCount = 1
For Each MyList In wbWorkingList.Sheets("Pending").Range("A:A").SpecialCells(xlCellTypeConstants)


                    Application.Workbooks.OpenText MyList.Value, xlMSDOS, 1, xlDelimited, xlDoubleQuote, Tab:=True, _
                    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1))
                    Set wbtext = ActiveWorkbook

                    myTextColumns = wbtext.Sheets(1).UsedRange.Columns.Count
        Set found = wbtext.Sheets(1).Columns("A").Find("H1000", , xlFormulas, xlWhole)

               If found Is Nothing Then
                   
                          With wbWorkingList.Sheets("Bad_Files").Range("A" & Rows.Count).End(xlUp).Offset(1)
                          .Value = MyList.Value
                          .Offset(, 2).Value = loopCount
                          .Offset(, 3).Value = "No H1000"
                          End With
                    Else
                        StartRow = found.Row
                        wbtext.Sheets(1).Range(Cells(StartRow, 1), Cells(StartRow, myTextColumns)).Copy
                        With wbWorkingList.Sheets("new_fields").Range("A" & Rows.Count).End(xlUp).Offset(1)
                            .Value = MyList.Value
                            .Offset(, 2).Value = loopCount
                            .Offset(, 3).PasteSpecial
                        End With
                         
                         
                         
                    End If
        Application.CutCopyMode = False
        wbtext.Close
        Set wbtext = Nothing
        loopCount = loopCount + 1
        'wbWorkingList.Save
        
Next MyList
Application.DisplayAlerts = True
    Application.ScreenUpdating = True
MsgBox ("finis")
End Sub
I tried running this macro on my Windows 7, Excel 2013 machine. As before, at 210th file the machine crashed with the exceptions error. I then tried running the same macro on my Windows Vista machine with Excel 2010. The full list of 3500 files were processed without incident. To me it would seem that Microsoft is doing something fundamentally different with its memory management in 2013 compared with 2010.
Regards,
Peter
 
Upvote 0
PeterTaylor,

Dear all,
there has been a development with this problem that I thought I might share. Below is a variant of the code in the original problem; it essentially does the same thing but with less "set" statements.
Click to expand...

I tried running this macro on my Windows 7, Excel 2013 machine. As before, at 210th file the machine crashed with the exceptions error. I then tried running the same macro on my Windows Vista machine with Excel 2010. The full list of 3500 files were processed without incident. To me it would seem that Microsoft is doing something fundamentally different with its memory management in 2013 compared with 2010.
Click to expand...


Thanks for the feedback, and, update.

Glad you were able find a solution.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
fix error 1004 when the sheet is protected
Replies
1
Views
338
dave3009
dave3009
M
  • Question
search in worksheet for multiple words via userform
Replies
6
Views
339
Max01
M
D
  • Question
VBA based on cell value search for it in the table and then copy a row (help with existing code)
Replies
1
Views
351
DanteAmor
DanteAmor
M
  • Question
How to copy one row from the specific found cell from one sheet to another
Replies
0
Views
279
mahshadrashidpour
M
S
  • Solved
Undo is greyed out
Replies
7
Views
539
sspatriots
S

Forum statistics

Threads
1,215,655
Messages
6,126,054
Members
449,283
Latest member
GeisonGDC

Share this page

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