VBA - Close workbook after acquiring necessary information

Question

Your assistance is required on solving this world (Excel VBA) problem. I am using a VBA to populate an immense workbook (500 Cells per row), from a bucket load of workbooks(Qty=96). The VBA I am using got created by [@Kevin][1] and it works for about 20 files until my pc runs out of memory and crashes Excel. This kind of works great for working with such an immense amount of cells per workbook, because opening and closing each workbook adds up to the process quite a lot. Opening each work book and copy all 500 cells and close, then proceed with the next one and so on x ±96 times, but that would be more complicated than just making this one work, if you have any of the 2 solutions please help!

Here is the VBA I am using:

Function GetField(Path As String, WorksheetName As String, CellRange As String) As Variant

Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range

Set wb = GetObject(Path)
Set ws = wb.Worksheets(WorksheetName)
Set rng = ws.Range(CellRange)

GetField = rng.Value

wb.close 

End Function

Tyeler · Accepted Answer

Updated Answer

To answer your original question, you have to activate the workbook first, then close the active workbook. However, doing this in a function is very poor practice and will more than likely perform in non-intuitive ways.

The following is the fix to your original code:

Function GetField(Path As String, WorksheetName As String, CellRange As String) As Variant

    'code

    wb.Activate 'Activate the opened workbook
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close 'Close the active workbook

End Function

Performing the .Close inside your function is not advised.

Instead, to achieve the same thing without worry, make a Sub to close the workbooks that are opened by your function. We can achieve this by doing the following:

Sub closeWB(Path As String)
    Dim wb As Workbook
    Set wb = GetObject(Path)
    wb.Activate
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close
End Sub

And then call on it from the same place you're calling your function. Just place it after the function call..

Sub YourMainSub()
    Path = "C:\Users\you\Desktop\file example.xlsm"
    something.GetField(Path, "Sheet 1", "A1")
    Call closeWB(Path)
End Sub

After a lot of discussion between Allan and I, we discovered a solution to his problem. Ultimately using a UDF on the worksheet wasn't meeting his needs. As such we changed directions and made a routine that essentially did the same thing, but without having worksheet functions. This not only reduced the file size, but also made importing the data and setting up for the data import significantly faster. Below is a sample excerpt, in case anyone with this same issue wants a second option that may perform better.

I could have put the data importing (Where we Call DataLoop()) in it's own For loop, but chose not to because maintaining a simple easy to edit code was more important than visual efficiency.

'The function that imports the data
Public Function GetField(Path, file, WorksheetName, CellRange) As Variant
   Dim wb As Workbook, ws As Worksheet, rng As Range, field As String

   If Right(Path, 1) <> "" Then Path = Path & ""

   If Dir(Path & file) = "" Then
       GetField = "File Not Found"
       Exit Function
   End If

   field = "'" & Path & "[" & file & "]" & WorksheetName & "'!" & Range(CellRange).Range("A1").Address(ReferenceStyle:=xlR1C1)
   GetField = ExecuteExcel4Macro(field)
End Function

'A loop that calls on the function
Sub DataLoop(DataRange As Range, SourceRow As Long, SourceColumn As Integer, Path, file, WorksheetName)
    Dim rcell

    For Each rcell In DataRange
        rcell.Value = GetField(Path, file, WorksheetName, Cells(SourceRow, SourceColumn).Address(RowAbsolute:=False, ColumnAbsolute:=False))
        SourceColumn = SourceColumn + 1
    Next rcell
End Sub

'The main routine where we define where data goes and comes from
Sub DataEntry()
    Dim dataWS As Worksheet, Path1 As String, WsName1 As String

    Dim testFileName As Range, file

    Dim avgDmmV As Range, avgPSTATADCV As Range, ppPSTATADCV As Range

    Dim gainLO0A As Range, gainLO0B As Range, gainLOm10A As Range, gainLOm10B As Range
    Dim gainLO10A As Range, gainLO10B As Range, gainLO20A As Range, gainLO20B As Range
    Dim gainLO60A As Range, gainLO60B As Range

    Set dataWS = ThisWorkbook.Sheets("DATA")
    Path1 = "\server5\Operations\MainBoard testing central location DO NOT REMOVE or RENAME" 'File path Location
    WsName1 = "Summary"

    'The values of the cells in this range have the names of the .xls files
    Set testFileName = dataWS.Range("A6", dataWS.Range("A6").End(xlDown)) 

    For Each file In testFileName 'Loop through each file name
        dataRow = file.Row

        Set avgDmmV = dataWS.Range("C" & dataRow & ":F" & dataRow)
        Set avgPSTATADCV = dataWS.Range("H" & dataRow & ":M" & dataRow)
        Set ppPSTATADCV = dataWS.Range("Q" & dataRow & ":W" & dataRow)

        Set gainLO0A = dataWS.Range("Y" & dataRow & ":AG" & dataRow)
        Set gainLO0B = dataWS.Range("AI" & dataRow & ":AQ" & dataRow)
        Set gainLOm10A = dataWS.Range("AS" & dataRow & ":BA" & dataRow)
        Set gainLOm10B = dataWS.Range("BC" & dataRow & ":BK" & dataRow)
        Set gainLO10A = dataWS.Range("BM" & dataRow & ":BU" & dataRow)
        Set gainLO10B = dataWS.Range("BW" & dataRow & ":CE" & dataRow)
        Set gainLO20A = dataWS.Range("CG" & dataRow & ":CO" & dataRow)
        Set gainLO20B = dataWS.Range("CQ" & dataRow & ":CY" & dataRow)
        Set gainLO60A = dataWS.Range("DA" & dataRow & ":DI" & dataRow)
        Set gainLO60B = dataWS.Range("DK" & dataRow & ":DS" & dataRow)

        Call DataLoop(avgDmmV, 9, 5, Path1, CStr(file.Value), WsName1)
        Call DataLoop(avgPSTATADCV, 15, 5, Path1, CStr(file.Value), WsName1)
        Call DataLoop(ppPSTATADCV, 18, 5, Path1, CStr(file.Value), WsName1)

        Call DataLoop(gainLO0A, 31, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLO0B, 32, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLOm10A, 33, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLOm10B, 34, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLO10A, 35, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLO10B, 36, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLO20A, 37, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLO20B, 38, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLO60A, 39, 3, Path1, CStr(file.Value), WsName1)
        Call DataLoop(gainLO60B, 40, 3, Path1, CStr(file.Value), WsName1)
    Next file
End Sub

VBA - Close workbook after acquiring necessary information

Answers (2)

Related Questions