Loop Through All Files, Manipulate and Copy Data to Summary Workbook with VBA

[AlexB123]

Hi all,

I am working on something to help me analyze a bunch of queries in an Access database. To motivate this I exported all the queries to .csv in a particular folder. I want the output to be in a format so that I can filter on the query and pull up the associated SQL statements for quick review within Excel.

In "A1" of each file exists the name of the query. From "A2" until the end of values (only 2 to 5 rows for any given file) is a SQL statement. First I want to copy the SQL statements to column B, then I want to copy the query name on to every row in A where there is a SQL statement in B. Last, I want to copy the complete, manipulated data to a Summary worksheet. Since my code loops through every file in the folder, I need to dynamically update the rows to paste to in the Summary sheet.

I was able to get the code to work on a small number of files (2-5), but it failed when I attempted to run on all the files in the folder. I believe the operations are overloading the memory of the application, and that my setting of ranges is interfering with the application.

I appreciate any feedback. I've left all the comments so that you can see what I tried previously.

Sub MergeQueries_partOne()
' Macro manipulates data, leaving the top cell in column A, but moves everything from A2 down over to column B. 
' The macro then copies the data in A1 down the empty cells in A where there is a value in column B. 
' The final piece of the macro moves the finished, manipulated data to a summary workbook and worksheet, pasting below the last 
' used row of previous copies. The macro will produce a summary workbook of all the dat in all files in the folder.
' partOne simply moves the SQL query statements to column B
' Declare variables
    Dim SummaryWB As Workbook
    Dim SummarySheet As Worksheet
    Dim queryPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRange1 As Range
    Dim SourceRange2 As Range
    Dim DestRange1 As Range
    Dim DestRange2 As Range
    Dim r1Count As Long
    Dim r2Count As Long
    Dim r3Count As Long
    Dim queryName As String
    Dim queryCopy As Range
    Dim copyRange As Range
    Dim pasteRange As Range
    
' Set app updating properties
    With Application
        .Calculation = CalcMode
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    
' Create a new workbook and set a variable to the first sheet
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
 ' Set SummarySheet = ThisWorkbook.Worksheets(1)
    ' Considered using ThisWorkbook property to make the summary workbook equal to the open workbook where macro was created
 
 
' Folder path - using dummy path
    queryPath = "C:\Users\ALEX\Desktop\QueryCsvs\"
    
' Initialize variable to track last used row
    NRow = 1
    
' Call Dir for first time, pointing to all .csv files in folder path
    FileName = Dir(queryPath & "*.csv")
    
' Loop until Dir returns an empty string

        Do While FileName <> ""
                    
            Set WorkBk = Workbooks.Open(queryPath & FileName) 'Set working file from folder
            
            'Activate WorkBk
            
            WorkBk.Activate
            
            'Count number of initial rows
            'r1Count = WorkBk.Worksheets(1).Cells(.Rows.Count, "A").End(xlUp).Row - first attempt
            r1Count = ActiveSheet.Range("A1", ActiveSheet.Cells(Rows.Count, 1).End(xlUp)).Rows.Count
            r2Count = r1Count - 1 ' Calculate for paste into column B
            
            'Set the source range of initial data
            Set SourceRange1 = WorkBk.Worksheets(1).Range("A2:A" & r1Count)
            Set SourceRange2 = WorkBk.Worksheets(1).Range("B1:B" & r2Count)
        
            'Copy SQL code over to column B in source workbook
            SourceRange1.Select
            SourceRange1.Copy Destination:=SourceRange2
            'Now clear values out of SourceRange1
            SourceRange1.ClearContents
            
            'Now use msgBox to print results during testing
            'MsgBox ("r1Count is equal to: " & r1Count & ". r2Count is equal to: " & r2Count)
            
   'Copy the query name, that is the string value of A1
            WorkBk.Worksheets(1).Range("A1").Copy Destination:=WorkBk.Worksheets(1).Range("A2:A" & r2Count)
            
   'Declare a variable to help define the bottom and the rightmost cell of manipulated data to aid in transfer
   'to summary sheet
   r3Count = NRow + r2Count
            SummarySheet.Activate
            
   'Next two comments were original attempt to set the range to paste to in the summary book
            'Set pasteRange = SummarySheet.Range(Cells("A" & NRow & ":B" & r3Count)
            'Set pasteRange = pasteRange.Resize(r2Count, 2)
                       
            'This is the code that succeeded in pasting data to summary sheet
   WorkBk.Worksheets(1).Range("A1:B" & r2Count).Copy Destination:=SummarySheet.Cells(NRow, 1)
            
   'Below code did not run, but attempted to handle dynamic ranges
            'Now select copy range in source workbook
                'Set queryCopy = WorkBk.Worksheets(1).Range("A1:B" & r2Count)
                'Set target range for summary workbook and ensure same size as source range
                    
                    'error handling for first case
                    'If NRow = 1 Then
                 '       SummarySheet.Activate
                  '      Set pasteRange = SummarySheet.Range("A" & NRow)
                   '     Set pasteRange = pasteRange.Resize(r2Count, 2)
                    'Else
                     '   Set pasteRange = SummarySheet.Range("A" & NRow & ":B" & r3Count)
                      '  Set pasteRange = pasteRange.Resize(r2Count, 2)
                    'End If
                
                'Copy and paste from source to destination
                'queryCopy.Copy Destination:=pasteRange
                'queryCopy.Value = pasteRange.Value
                
                ' increase NRow each iteration
                'NRow = SummarySheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Choose next empty row after lastrow used
                NRow = NRow + r2Count
          
                'or try:
                'NRow = Nrow + pasteRange.Rows.Count
                
                'Now close source workbook without saving changes
                WorkBk.Close SaveChanges:=False
            
                
                ' Use Dir to get next file name
                FileName = Dir()
            
        Loop
        
      'Call autofit for readability of info
      SummarySheet.Select
      SummarySheet.Columns.AutoFit
      SummarySheet.SaveAs queryPath & "TEST\" & "QueryTestResultsA"
' release application properties
      
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
  
            
End Sub

 

[Roderick_E]

Look likes you've thought this out. Typically when a code runs on a smaller set but not on a larger, the breakdown is not that it's a larger set but that something is different on the next set. Can you input msgbox tests in your code to help you determine when/where it is breaking?

 

[AlexB123]

Hi Roderick_E!

I had put a couple msgbox texts in the code above, and commented out. I added those back in, and then added another to see what my "SourceRange1" and "SourceRange2" were. My thinking was then I could test my destination ranges. I realized I'm not setting any ranges in my summary sheet b/c I couldn't get them to compile.

The first two source ranges work fine. To test the copy range after the data manipulations, I added:

'Now use msgBox to print SourceRange Results
            Dim c1 As Range
            Dim sTxt1 As String
            For Each c1 In SourceRange1
               sTxt1 = sTxt1 & vbLf & c1.Value
            Next c1
                         
            Dim c2 As Range
            Dim sTxt2 As String
            For Each c2 In SourceRange2
               sTxt2 = sTxt2 & vbLf & c2.Value
            Next c2
            
            MsgBox ("SourceRange1 is equal to: " & sTxt1 & vbNewLine & "SourceRange2 is equal to : " & sTxt2)

This returns the string values, so confirms that is okay, although I would like to get the cell references ...

At the end of the loop, before the second call to Dir(), I also added:

'Attempt to handle memory issues
                Set WorkBk = Nothing
                Set SourceRange1 = Nothing
                Set SourceRange2 = Nothing

I thought that might help release some of the memory. When I ran it on two spreadsheets, worked fine, except the .SaveAs call wouldn't work. So I saved it manually, but Excel gave me an error that the workbook was heavily corrupted.

I went ahead and ran a trial on fifty workbooks. Before excel crashed it paused, and I checked my task manager - Excel was taking up significant memory, but not much processing power.

My guess at the moment? I need to declare, set and release "pasteRange" and get it to work, and I need to make sure all the memory is released inside the loop after all the data manipulations. But I am not sure how to achieve either of those things.

Any other suggested places for msgbox?

 

[AlexB123]

Update:

I ran just the first part of the code on fifty workbooks to see if doing the data manipulations on many items would fail, and set .Close SaveChanges:=True.

It took over fifteen minutes to run, but it did complete and save the changes. So the memory issues seem to be inside the loop itself?

I've read that global variables can cause memory issues, as does not releasing objects. Ideas or approaches?

I'm open to breaking the process up into different subs ... at least until I get it to work.

 

[Roderick_E]

Alex, thanks for the details. Maybe you simply need to wrap the code in something to turn off events and such? I see you've done a bit of that already:

'Display wait for a moment
Application.StatusBar = "****Please Wait*****  Macro processing"
'opitmize macro by disabling all processes that slow it down.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False

'Re-enable screenupdating (before END SUB)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.StatusBar = False

 

[AlexB123]

Hi Roderick,

Hoping you can still help me. So I went piece by piece and stepped through the code. I ended up breaking what I wanted to do into separate modules ... at least until I can get it to work. So the first one runs through and manipulates the data uniformly, and will run on all 411 .csv files. The second one will copy all the data to a new workbook, but only if I close Excel after the first macro runs.

I'm guessing all the data is written to the Excel clipboard, and eventually the memory just crashes it.

I would at least like to be able to run the macros concurrently, if not eventually put them in to a single sub.

The code for the data manipulation macro is:

Sub MergeQueries_partFive()
' Macro manipulates data, leaving the top cell in column A, but moves everything from A2 down over to column B.
' The macro then copies the data in A1 down the empty cells in A where there is a value in column B.
' partOne simply moves the SQL query statements to column B
' Declare variables
    Dim queryPath As String
    Dim FileName As String
    Dim queryName As String
    
' Set app updating properties
    With Application
        .Calculation = CalcMode
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
' Folder path - using dummy path
    queryPath = "C:\\Users\Alex\Desktop\TEST\"
        
' Call Dir for first time, pointing to all .csv files in folder path
    FileName = Dir(queryPath & "*.csv")
    
' Loop until Dir returns an empty string
        Do While FileName <> ""
                    
            Dim WorkBk As Workbook
            Dim SourceRange1 As Range
            Dim SourceRange2 As Range
            Dim r1Count As Long
            Dim r2Count As Long
                
                Set WorkBk = Workbooks.Open(queryPath & FileName) 'Set working file from folder
            
                'Activate WorkBk
            
                WorkBk.Activate
            
                'Count number of initial rows
                r1Count = ActiveSheet.Range("A1", ActiveSheet.Cells(Rows.Count, 1).End(xlUp)).Rows.Count
                r2Count = r1Count - 1 ' Calculate for paste into column B
            
                'Set the source range of initial data
                Set SourceRange1 = WorkBk.Worksheets(1).Range("A2:A" & r1Count)
                Set SourceRange2 = WorkBk.Worksheets(1).Range("B1:B" & r2Count)
        
                'Copy SQL code over to column B in source workbook
                SourceRange1.Select
                SourceRange1.Copy Destination:=SourceRange2
                'Now clear values out of SourceRange1
                SourceRange1.ClearContents
            
                'Copy the query name, that is the string value of A1
                WorkBk.Worksheets(1).Range("A1").Copy Destination:=WorkBk.Worksheets(1).Range("A2:A" & r2Count)
            
                'Now close source workbook and save changes
                WorkBk.Close SaveChanges:=True
            
                'Attempt to handle memory issues
                Set WorkBk = Nothing
                Set SourceRange1 = Nothing
                Set SourceRange2 = Nothing
                
                ' Use Dir to get next file name
                FileName = Dir()
            
        Loop
        
      
' release application properties
      
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
  
            
End Sub

The second macro, the one that copies all the data from each file in the folder, is:

' This only runs the data manipulations. Code was optimized for memory concerns.
' Breaking the functions apart. Already manipulated data, so only copy and paste operations.

Sub MergeQueries_part8()
' Macro manipulates data, leaving the top cell in column A, but moves everything from A2 down over to column B.
' The macro then copies the data in A1 down the empty cells in A where there is a value in column B.
' The final piece of the macro moves the finished, manipulated data to a summary workbook and worksheet, pasting below the last
' used row of previous copies. The macro will produce a summary workbook of all the dat in all files in the folder.
' partOne simply moves the SQL query statements to column B
' Declare variables
    Dim SummaryWB As Workbook
    Dim SummarySheet As Worksheet
    Dim SummaryWBLink As String
    Dim queryPath As String
    Dim FileName As String
    Dim queryName As String
       
' Set app updating properties
    With Application
        .StatusBar = "****Please Wait****  Macro Processing"
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
    End With
        
        ' Working folder path
        SummaryWBLink = "C:\\Users\Alex\Desktop\TEST\SummaryWB3.xlsx"
        queryPath = "C:\\Users\Alex\Desktop\TEST\"
        
        ' Open new workbook to store aggregate data and set a variable to the first sheet
        Workbooks.Open SummaryWBLink
        Set SummaryWB = ActiveWorkbook
                
        ' Call Dir for first time, pointing to all .csv files in folder path
        FileName = Dir(queryPath & "*.csv")
    
            ' Loop until Dir returns an empty string
            Do While FileName <> ""
            
                ' Declare variables within loop
                Dim WorkBk As Workbook
                Dim srcRange As Range
                Dim srcCount As Long
                Dim lastrow As Variant
                
                'Set and activate WorkBk
                Set WorkBk = Workbooks.Open(queryPath & FileName) 'Set working file from folder
                WorkBk.Activate
            
                'Count number of rows
                srcCount = ActiveSheet.Range("A1", ActiveSheet.Cells(Rows.Count, 1).End(xlUp)).Rows.Count
                
                'Set the source range data
                Set srcRange = WorkBk.Worksheets(1).Range("A1:B" & srcCount)
                
                ' Copy to SummaryWB
                'Range("A1:B" & srcCount).Copy
                srcRange.Copy
                    
                'Activate destination workbook, find last row, and paste source data
                SummaryWB.Activate
                    lastrow = Rows.Range("A65000").End(xlUp).Row
                    Range("A" & lastrow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                'Now close source workbook without saving changes
                WorkBk.Close SaveChanges:=False
            
                'Attempt to handle memory issues
                Set WorkBk = Nothing
                Set srcRange = Nothing
                Set lastrow = Nothing
                
                ' Use Dir to get next file name
                FileName = Dir()
            
        Loop
    SummaryWB.Save
    ' reenable optimazation settings
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
        .StatusBar = False
    End With
  
            
End Sub

I appreciate any help or feedback!