VBA to close workbooks

[CantGetRight]

Hi there,

I have a macro which opens files based on the contents of a cell range. This cell range has the file names and the macro specifies the folder directory. The macro opens whatever cells are selected and then it closes all files.

I want it to run as is but with one minor tweak - only to close the files it opened (selected cells) and to leave the other Excel files open.

Can anyone help?

Thanks - Code Below.

Mark



Sub OpenWorkBooksandRefreshFormulas()

'
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'safety prompt
Dim Sure As Integer
Sure = MsgBox("This is a sample message box.", vbYesNo)
If Sure = vbYes Then

Set MasterWB = ThisWorkbook

Dim filename As String


On Error Resume Next

For Each r In Selection


Workbooks.Open filename:= _
"\\Sample File Path\2015\" & r.Value & ".xlsm", UpdateLinks:=0

Next


MasterWB.Activate

On Error Resume Next

Calculate

On Error Resume Next

Dim xWB As Workbook

On Error Resume Next

For Each xWB In Application.Workbooks
If Not (xWB Is Application.ActiveWorkbook) Then
xWB.Close savechanges:=False
End If
Next


Application.DisplayAlerts = True
Application.ScreenUpdating = True

End If

End Sub

 

[JackDanIce]

Untested, but see if this works for you:

Sub OpenWorkBooksandRefreshFormulas()


Dim r           As Range
Dim arr()       As Variant
Dim x           As Long


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With


    'safety prompt
    If MsgBox("This is a sample message box.", vbYesNo) = vbYes Then
            
        On Error Resume Next
        'Put files names into an array from the selected range
        arr = Selection.Value
        For Each r In Selection
            Workbooks.Open "\\Sample File Path\2015\" & r.Value & ".xlsm", UpdateLinks:=0
        Next r
        On Error GoTo 0
        
        ThisWorkbook.Activate
        Calculate


        On Error Resume Next
        'close file names from array
        For x = LBound(arr, 1) To UBound(arr, 1)
            Workbooks(CStr(arr(x, 1)) & ".xlsm").Close savechanges:=False
        Next x
        On Error GoTo 0
        
    End If
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    Erase arr
    
End Sub

 

[CantGetRight]

Hi JackDanIce,

Thanks for your response.

So I tried various scenarios to make sure this functioned with all.

Selected 3 cells in the array, it closes the first file in the 3 but the other two remain open.
Selecting simply one cell it doesn't close the file.

My current code will close all the files it just opened. However it will also close any other files (except master file which runs this macro).

Any further advice on how to get this to work would be much appreciated.

Best,
Mark

 

[JackDanIce]

Hi Mark,

It may be with the ON ERROR statements only 1 file is actually opening and the other 2 are not, but the ON ERROR part skips if it can't open it, so it seems like 3 cells were selected but not necessarily 3 files were opened. I've included a counter to count how many files are opened (displayed back to you via a message box after the loop finishes) and similar for when closing. If this doesn't work, I'd suggest removing all ON ERROR statements entirely and reporting back the errors, if any, are shown.For now, try:

Sub OpenWorkBooksandRefreshFormulas()

Dim r           As Range
Dim arr()       As Variant
Dim x           As Long
Dim OpenCount   As Long

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    'safety prompt
    If MsgBox("This is a sample message box.", vbYesNo) = vbYes Then
            
        On Error Resume Next
        'Put files names into an array from the selected range
        arr = Selection.Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            Workbooks.Open "\\Sample File Path\2015\" & CStr(arr(x, 1)) & ".xlsm", UpdateLinks:=0
            OpenCount = OpenCount + 1
        Next r
        On Error GoTo 0
        MsgBox "Opened: " & OpenCount & " workbooks", vbOKOnly
        
        ThisWorkbook.Activate
        Calculate

        'On Error Resume Next
        'close file names from array
        OpenCount = 0
        For x = LBound(arr, 1) To UBound(arr, 1)
            With Workbooks(CStr(arr(x, 1)) & ".xlsm")
                .Activate
                .Close savechanges:=False
                OpenCount = OpenCount + 1
            End With
        Next x
        'On Error GoTo 0
        MsgBox "Closed: " & OpenCount & " workbooks", vbOKOnly
        
    End If
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    Erase arr
    
End Sub

 

[JackDanIce]

Actually, try this code instead:

Sub OpenWorkBooksandRefreshFormulas()

Dim r           As Range
Dim arr()       As Variant
Dim x           As Long
Dim OpenCount   As Long
Dim wb          As Workbook

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    'safety prompt
    If MsgBox("This is a sample message box.", vbYesNo) = vbYes Then
            
        On Error Resume Next
        'Put files names into an array from the selected range
        arr = Selection.Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            Set wb = Workbooks.Open("\\Sample File Path\2015\" & CStr(arr(x, 1)) & ".xlsm", UpdateLinks:=0)
            If Not wb Is Nothing Then
                OpenCount = OpenCount + 1
                Set wb = Nothing
            End If
        Next r
        On Error GoTo 0
        
        MsgBox "Opened: " & OpenCount & " workbooks", vbOKOnly
        
        ThisWorkbook.Activate
        Calculate

        On Error Resume Next
        'close file names from array
        OpenCount = 0
        For x = LBound(arr, 1) To UBound(arr, 1)
            Set wb = Workbooks(CStr(arr(x, 1)) & ".xlsm")
            If Not wb Is Nothing Then
                With wb
                    .Activate
                    .Close savechanges:=False
                    OpenCount = OpenCount + 1
                End With
                Set wb = Nothing
            End If
        Next x
        On Error GoTo 0
        MsgBox "Closed: " & OpenCount & " workbooks", vbOKOnly
        
    End If
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    Erase arr
    Set wb = Nothing
    
End Sub

 

[CantGetRight]

So I know the first code you provided (as well as my initial code) is working because the purpose of this is to open these files so that the index match formulas populate rather than showing an error. The other giveaway from your first code is that the second two files in the array both remain open afterwards while the first cell in the array closes but the formula now appears.




To follow up on your response though I am noticing the following:


The most recent code is hitting an error.

"Compile Error:

Invalid Next control variable reference"

At the following line (enlarged/bolded/underlined below):


Sub OpenWorkBooksandRefreshFormulas2()

Dim r As Range
Dim arr() As Variant
Dim x As Long
Dim OpenCount As Long
Dim wb As Workbook

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

'safety prompt
If MsgBox("This is a sample message box.", vbYesNo) = vbYes Then

On Error Resume Next
'Put files names into an array from the selected range
arr = Selection.Value
For x = LBound(arr, 1) To UBound(arr, 1)
Set wb = Workbooks.Open("\\Sample File Path\2015\" & CStr(arr(x, 1)) & ".xlsm", UpdateLinks:=0)
If Not wb Is Nothing Then
OpenCount = OpenCount + 1
Set wb = Nothing
End If
Next r
On Error GoTo 0

MsgBox "Opened: " & OpenCount & " workbooks", vbOKOnly

ThisWorkbook.Activate
Calculate

On Error Resume Next
'close file names from array
OpenCount = 0
For x = LBound(arr, 1) To UBound(arr, 1)
Set wb = Workbooks(CStr(arr(x, 1)) & ".xlsm")
If Not wb Is Nothing Then
With wb
.Activate
.Close savechanges:=False
OpenCount = OpenCount + 1
End With
Set wb = Nothing
End If
Next x
On Error GoTo 0
MsgBox "Closed: " & OpenCount & " workbooks", vbOKOnly

End If

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

Erase arr
Set wb = Nothing

End Sub

 

[JackDanIce]

Typo (change in red), try:

Sub OpenWorkBooksandRefreshFormulas()

Dim arr()       As Variant
Dim x           As Long
Dim OpenCount   As Long
Dim wb          As Workbook

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    'safety prompt
    If MsgBox("This is a sample message box.", vbYesNo) = vbYes Then
            
        On Error Resume Next
        'Put files names into an array from the selected range
        arr = Selection.Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            Set wb = Workbooks.Open("\\Sample File Path\2015\" & CStr(arr(x, 1)) & ".xlsm", UpdateLinks:=0)
            If Not wb Is Nothing Then
                OpenCount = OpenCount + 1
                Set wb = Nothing
            End If
        Next x
        On Error GoTo 0
        
        MsgBox "Opened: " & OpenCount & " workbooks", vbOKOnly
        
        ThisWorkbook.Activate
        Calculate

        On Error Resume Next
        'close file names from array
        OpenCount = 0
        For x = LBound(arr, 1) To UBound(arr, 1)
            Set wb = Workbooks(CStr(arr(x, 1)) & ".xlsm")
            If Not wb Is Nothing Then
                With wb
                    .Activate
                    .Close savechanges:=False
                    OpenCount = OpenCount + 1
                End With
                Set wb = Nothing
            End If
        Next x
        On Error GoTo 0
        MsgBox "Closed: " & OpenCount & " workbooks", vbOKOnly
        
    End If
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    Erase arr
    Set wb = Nothing
    
End Sub

 

[CantGetRight]

Hi JackDanIce,

Thanks for all this back and fourth.

This only works for the first file in the array - highlighted 2 cells but only opened 1 (which it successfully closed). Also I'm assuming the message box is just for testing purposes as it requires an acknowledgement mid macro for it to keep running.

My macro and your first one posted seem to be achieving the most desirable results so far.

Is there any other method to try that you're aware of?

Thanks,
Mark

 

[JackDanIce]

No, the message box confirms how many files actually opened - i.e. you could have spelling mistakes in the cells, hence why they might not open, so it's to reconcile what you think should happen, against what then happens.

Without knowing your spreadsheet or seeing it in front of me or the files in the specified folder, I can only guess what you're after, based on the information given.

On a test run with different locations and file names, the above works for me - i.e. opens and closes only specified files from the selection. Personally, I would advise NOT to use an ActiveSelection and an actual Range, e.g.

arr = Range("A1:A10").Value

Then you know for sure the correct range is being used in the macro.

 

[CantGetRight]

I understand that using the named range is the preferred method but then this macro wouldn't achieve what is needed.

The message box prompts the user to hit OK both for the number of files opened and then again for the number of ones that closed. But it seems as though it pauses the macro until the user acknowledges.

The cells aren't misspelled as it works perfectly using the macro I provided and the first one you provided. I don't need a message box to tell me the macro opened a number of workbooks because the indirect formulas reference the cells (containing file names) in an INDEX MATCH formula. Once the macro runs these formulas change from REF ERRORS to our desired value. If the file didn't open or the file was misspelled these values would remain REF ERRORS.

Are we able to step back a bit and use the first code I provided (or the one you first provided) and simply tweak the close functionality?

Thanks again,
Mark