loop through files in a folder based on a condition

[carissa7]

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...2139421395

[Leith Ross]

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

[carissa7]

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!

[Leith Ross]

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

[carissa7]

awesome thanks loads for all your help!!!