将条件应用于下面的processRange函数并执行循环

Question

[table - worksheet＆＃34; output - flat＆＃34;] [1]

我有下面的代码检查列＆＃34; NamedRange＆＃34;在附加表中显示为（dstRng）模板中的命名范围，如果它确实存在，则返回右侧的值（＆＃34;报告余额＆＃34;）。如何添加条件，当用户选择模板时，它将仅返回基于Ted ID的值 - 在附表中。我有2个模板，它循环遍历两个模板但是我希望第一个模板只返回Ted ID 10004和模板2的值，它只返回Ted ID 11372等的值等。希望有意义...让我知道你是否有任何问题

Option Explicit

Sub Button4_Click()

    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")
                        'unprotect workbook
                        wsLocal.Unprotect Password:="KqtgH5rn9v"
                        wsGroup.Unprotect Password:="KqtgH5rn9v"
                    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)
                        'lock the workbook
                        wsLocal.Protect Password:="KqtgH5rn9v"
                        wsGroup.Protect Password:="KqtgH5rn9v"

                        ''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
             'Copy the report balance to the Template worksheet in column "G".
            dstRng.Value = rngName.Offset(0, 1).Value
         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