VBA Keep Workbook open while looping

Question

I would like to know if there is a way of keeping the Workbook open and close it after every Number is checked (after the Loop ends).

I have this Code:

Sub TESTReadDataFromAnotherWorkBook(ActCell As Range)       

    Dim sFound As String
    Dim swb As Workbook

    sFound = Dir(ActiveWorkbook.Path & "\test\" & "FileINeed_*")    
    If sFound <> "" Then
       Set swb = Workbooks.Open(ActiveWorkbook.Path & "\test\" & sFound, True, True)
       Debug.Print "FOUND IN DIR: " & sFound
    End If
    
    Debug.Print "Processing workbook '" & swb.Name & "'..."
    
    Dim sString As String: sString = ActCell.Value                                
    
    Debug.Print "Searching for '" & sString & "'..."
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim sCell As Range
    Dim fAddress As String
    
    Dim tnFound As Boolean
    tnFound = False
    
    Dim notChangedBool As Boolean                                                          
    notChangedBool = False
    
    swb.Windows(1).Visible = False                    ' Reduces flickering - speeds up the process     
    Application.ScreenUpdating = False
    
    For Each sws In swb.Worksheets
     If ((sws.Name = "Test1") Or (sws.Name = "Test2") Or (sws.Name = "Test3")) Then                  ' Only look into the 3 Sheets
        Debug.Print "Processing worksheet '" & sws.Name & "'..."
        Set srg = sws.UsedRange
        Set sCell = srg.Find(What:=sString, _
            After:=srg.Cells(srg.Rows.Count, srg.Columns.Count), _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows)
        If Not sCell Is Nothing Then
            fAddress = sCell.Address
            Do
                Debug.Print "Found string in '" & sCell.Address(0, 0) _
                    & "'. The value in " & sCell.Offset(, 1).Address(0, 0) _
                    & " is " & sCell.Offset(, 1).Value
                Set sCell = srg.FindNext(sCell)
                tnFound = True
            Loop Until sCell.Address = fAddress
            
            
            If (ActCell.Offset(, 14).Value = 3) Then                                                    
                Debug.Print "Value is 3"
                notChangedBool = True
                  
            
            ElseIf (sCell.Offset(, 1).Value = "-" And notChangedBool = False) Then                                     
                Debug.Print sCell.Offset(, 1).Value
                Debug.Print "ActiveCell? : " & ActCell.Address
                ActCell.Offset(, 14).Value = 0
                                                                                                     
            ElseIf (sCell.Offset(, 1).Value <> "-" And notChangedBool = False) Then
                Debug.Print sCell.Offset(, 1).Value
                ActCell.Offset(, 14).Value = 2
                
            End If
            
        End If
        
        End If
        
    Next
    swb.Close False

End Sub

What this code does is it opens a Workbook and loops threw 3 Sheets with a specific name. If the passed ActCell which holds a number is found in the Excel then it writes a 2 as the Value from the Excel where the Macro gets executed. If not it writes a 0.

The question is: How do I pass a Range, open the Workbook once, run the code for every Range Object and after that close the Workbook. It is important that the Function still works like before because if it finds the Number(ActCell) it should modify the ActiveCells.Offset Value.

This is the way I get the Range Object and I am currently running it in a Loop which means that it calls the Function again for every Number and Opens and Closes the Workbook therefore.

Private Sub CommandButton3_Click()                                                          

Dim searchRng As Range: Set searchRng = Range("A9:A5000")                                  
Dim r As Range

Dim StartTime As Double

Dim answer As Variant

    answer = MsgBox("Warning this could take some time..", vbOKCancel)
    
    If (answer = vbOK) Then
    
    StartTime = Timer
    
    For Each r In searchRng                                                         ' Loop threw Numbers that are not empty
        
        If (r.Value <> "") Then
            Debug.Print r                                                           'prints the Numbers that are searched         
            TESTReadDataFromAnotherWorkBook r                                    
      
        End If
        
    Next r
    
    MsgBox ("Done" & " || Runtime: " & Format((Timer - StartTime) / 86400, "hh:mm:ss"))
    
   End If

End Sub

The Problem here is that I do the same for 3 Functions. But the Excel that they open are small - which means that it happens very fast.

For the Function mentioned at the top the Excel that gets Opened is very Large... Therefore my Runtime is slow.

For comparison: Running the 3 other Functions (basically the same Function but opening different Excel) : Runtime 1:25min

Running the 1 Function that opens the Large Excel : Runtime 10:00min

So I thought of keeping the Excel Open so it does not have to close and reopen it all the time since that takes most time.

I have read about getObject() and Excel Jet but I could not find anything concrete.

FaneDuru FaneDuru · Accepted Answer · 2021-05-18T08:42:46

Please, try proceeding in the next way:

Move the next code part at the beginning of the "CommandButton3_Click()" Sub:

    Dim sFound As String
    Dim swb As Workbook

    sFound = Dir(ActiveWorkbook.Path & "\test\" & "FileINeed_*")    
    If sFound <> "" Then
       Set swb = Workbooks.Open(ActiveWorkbook.Path & "\test\" & sFound, True, True)
       Debug.Print "FOUND IN DIR: " & sFound
    End If
    
    Debug.Print "Processing workbook '" & swb.Name & "'..."

Add a new parameter to the "TESTReadDataFromAnotherWorkBook" Sub:

Sub TESTReadDataFromAnotherWorkBook(ActCell As Range, swb As Workbook)

Call the above Sub with ne new parameter, too:

'...your existing code
 TESTReadDataFromAnotherWorkBook r, swb
'... existing code

Remove swb.Close False from where it is now and add it after Next r.

VBA Keep Workbook open while looping

2 Answers