Consulting

Results 1 to 5 of 5

Thread: loop through files in a folder based on a condition

  1. #1

    loop through files in a folder based on a condition

    The code is in Module 1 of “workbook2” and the template to choose from the folder is attached. both are attached.

    Basically right now it prompts the user to select the template and performs the code perfectly, instead I want it to prompt the user to choose a folder the folder will be called “templates” and it will contain all the templates that I want it to perform the code on and then save them into an output folder called “output”

    The code works by looking to see if column (“NamedRange”) exists as a named range in the template and then returns the report balance if it does exist.
    However I want to add logic where for each template in the folder it will check the “Ted ID” in a table in ws "output - flat" and only bring back the values associated with that Ted ID.
    So in the table there are two different Ted ID’s so there will be two templates outputs

    The table is in “output - flat” tab in “workbook2” along with a “select all” checkbox. I want the code to only loop through all the workbooks and perform the above when the user clicks “ select all” and then “Send values” button.

    Let me know if this makes sense and thanks so much...template test.xlsmworkbook2.xlsm

  2. #2
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello carrisa7,

    Hopefully, I have understood you correctly about what this macro should do. I noticed the workbooks had links to existing workbooks on you system. Please be aware this macro will remove all links in the copied workbooks.

    This is necessary to allow the new workbook to be updated with links to "Workbook2". This means the only data you will see is from the named ranges that match. If you need the other data to be included then I will need to make some changes to the code.

    Give this code a try and let me know the results.

    Option Explicit
    
    
    ' Thread:   http://www.vbaexpress.com/forum/showthread.php?61805-loop-through-files-in-a-folder-based-on-a-condition
    
    
    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")
                        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
    Attached Files Attached Files
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  3. #3

    loop through files in a folder based on condition

    oh wow the folder templates prompt is great and the looping through files is awesome and the select checkbox is working perfectly

    Just two things I noticed:
    Its coping over all the values where it finds a matching named range in both templates however, is it possible to have the first template copy over values based on the first "Ted ID" and second template only copy values based on the second "Ted ID" ... maybe we can do this based on the template name? I can call the template name " Template_10004" and then it can do some sort of matching to know which ted id to pick up? just a thought.

    Lastly, I think this is a quick fix just not sure where to make the change.. the report balance should only be populated in the template of column G which is a named range called "CurrentTaxPerGroupGAAPProvision" in worksheet "RVP Group GAAP" and in RVP Local GAAP the named range is called "CurrentTaxPerLocalGAAPProvision also column G..right now its populating values in columns E and G.
    Also something to note, the templates are exactly the same, same worksheets in the templates.


    Thank you so much for the help... been struggling with this for days and I'm very new to VBA.

     

    other than those two things really appreciate the help it works fast too!
    Last edited by carissa7; 01-20-2018 at 10:31 AM.

  4. #4
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello carissa7,

    I fixed the problem with the report balance. It now appears only in column "G". Here is the updated code.

    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
                    End If
                On Error GoTo 0
            Next rngName
            
    End Sub
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  5. #5
    awesome thanks loads for all your help!!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •