Dim Desktop As Variant
    Dim Files   As Object
    Dim Folder  As Variant
    Dim oShell  As Object
    Dim Tmplts  As Variant      ' Templates folder
    Dim wsLocal As Worksheet
    Dim wsGroup As Worksheet
    Dim wb      As Object

        ' Check Box 2 "Select All" must be checked to run the macro.
        If ActiveSheet.Shapes("Check Box 2").ControlFormat.Value = xlOff Then Exit Sub

        Application.ScreenUpdating = False
        Application.EnableEvents = False

        ' Prompt user to locate the Templates folder.
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = True Then
                Tmplts = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With

        Set oShell = CreateObject("Shell.Application")

            Set Desktop = oShell.Namespace(0)

            ' Create the Output folder on the User's Desktop if it does not exist.
            Set Folder = Desktop.ParseName("Output")
                If Folder Is Nothing Then
                    Desktop.NewFolder "Output"
                    Set Folder = Desktop.ParseName("Output")
                End If

            Set Files = oShell.Namespace(Tmplts).Items
                Files.Filter 64, "*.xlsm"

                For Each wb In Files
                    Set wb = Workbooks.Open(Filename:=wb.Path, UpdateLinks:=False)

                    Call BreakLinks(wb)

                    On Error Resume Next
                        Set wsLocal = wb.Worksheets("RVP Local GAAP")
                        Set wsGroup = wb.Worksheets("RVP Group GAAP")
                    On Error GoTo 0

                    ' Check that both worksheets exist before updating.
                    If Not wsLocal Is Nothing And Not wsGroup Is Nothing Then
                        Call ProcessNamedRanges(wb)

                        MsgBox "Ranges have been updated sucessfully."

                        ' Save the workbook to the folder and close.
                        On Error Resume Next
                            wb.SaveAs Filename:=Folder.Path & "" & wb.Name
                            ActiveWorkbook.Close True
                        On Error GoTo 0
                    End If
                Next wb

        Application.ScreenUpdating = True
        Application.EnableEvents = True

End Sub

Sub ProcessNamedRanges(ByRef wb As Workbook)

    Dim dstRng      As Range
    Dim rng         As Range
    Dim rngName     As Range
    Dim rngNames    As Range
    Dim wks         As Worksheet

        Set wks = ThisWorkbook.Sheets("Output - Flat")

        ' Exit if there are no named ranges listed.
        If wks.Range("D4") = "" Then Exit Sub

        Set rngNames = wks.Range("D4").CurrentRegion
        Set rngNames = Intersect(rngNames.Offset(1, 0), rngNames.Columns(2))

        'Loop through all the values in NamedRange
        For Each rngName In rngNames
            ' Verify the Named Range exists.
            On Error Resume Next
                Set dstRng = wb.Names(rngName.Text).RefersToRange
                If Err = 0 Then
                    ' Create a link from the Template worksheet to the Report Balance.
                    dstRng.Value = rngName.Offset(0, 1).Value
                    dstRng.Offset(0, -2).Formula = "=" & rngName.Offset(0, 1).Address(True, Ture, xlA1, True)
                Else
                    'answer = MsgBox("The Named Range """ & rngName.Value & """ Does Not Exist" & vbLf & vbLf & "Continue?", vbYesNo + vbExclamation)
                    'If answer = vbNo Then Exit Sub
                End If
            On Error GoTo 0
        Next rngName

End Sub

Sub BreakLinks(ByRef wb As Workbook)

    Dim i       As Long
    Dim wbLinks As Variant

        wbLinks = wb.LinkSources(xlExcelLinks)

        If Not IsEmpty(wbLinks) Then
            For i = 1 To UBound(wbLinks)
                ActiveWorkbook.BreakLink wbLinks(i), xlLinkTypeExcelLinks
            Next i
        End If

End Sub