VBA Looping through files in a folder to achieve a set task.

W

warradoyle

New Member
Joined
Aug 29, 2014
Messages
18
Hi guys. New here to VBA and Visual Basic in general. I'm really struggling to get something done with my limited knowledge.

At the moment i have some code below in the procedure AddStartUpPeriod. This code copies values (value, invoicing, cost, foreCastedValue, foreCastedCost, foreCastedInvoicing) from the Project\PFRs\BHMMS.xls sheet upon clicking my "Populate Start of Period" button.

I have been attempting unsuccessfully to make this program now do the same thing but for the rest of the .xls files i have in my PFRs folder and copy them onto the same sheet in subsequent rows. Im aware that i need to loop around the rest of the files in that PFRs folder to get it to do the same thing but have so far continued to fail at this.

My second procedure currently loops around all the files in the PFRs folder but does nothing on them. I've tried to set my second procedure to be the entry point of the program and then add a parameter to AddStartUpPeriod and then call it from the second procedure but this didnt work for me.

I think my lack of VBA knowledge in general is hindering me progressing at this point so any help would be appreciated.

To reiterate. Im pretty much trying to do what my first procedure does except i want it to do that for all the files in my PFRs folder (not just on the one BHMMS file that i have hardcoded as the filepath) by looping through them all.



Code: 
Sub AddStartUpPeriod() 

'Click Button 1
'Declare variables
Dim PFR As Workbook 'Create workbook object - new spreadsheet
Dim filePath As String
'The file with all the PFR files are located on \PFRs
filePath = "...\PFRs\BHMMS.xls"
'Initializing
Set PFR = Workbooks.Open(filePath)
Dim value As Currency
Dim invoicing As Currency
Dim cost As Currency
Dim foreCastedValue As Currency
Dim foreCastedInvoicing As Currency
Dim foreCastedCost As Currency


value = PFR.Sheets("Summary").Range("H43").value 'copy cells required h43 into value
invoicing = PFR.Sheets("Summary").Range("H45").value 'copy h45 into invoicing
cost = Excel.WorksheetFunction.Sum(PFR.Sheets("Summary").Range("H40,H42")) 'copy sum of h42 and h40 into Cost
 
foreCastedValue = PFR.Sheets("Current Year & Forecast").Range("H16").value 'copy 16 into value
foreCastedInvoicing = PFR.Sheets("Current Year & Forecast").Range("H17").value 'copy 17 into invoicing
foreCastedCost = PFR.Sheets("Current Year & Forecast").Range("H15").value 'copy 15 into Cost

PFR.Close 'close the file

Sheets("Dashboard").Range("F18").value = value
Sheets("Dashboard").Range("G18").value = invoicing
Sheets("Dashboard").Range("H18").value = cost

Sheets("Dashboard").Range("L18").value = foreCastedValue
Sheets("Dashboard").Range("M18").value = foreCastedInvoicing
Sheets("Dashboard").Range("N18").value = foreCastedCost

End Sub


Sub LoopAllExcelFilesInFolder() 
'loops through all Excel files in a user specified folder and perform a set task on them

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select The Location of PFR files on your machine to Populate Period Start of Period From"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With
'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then Exit Sub
'Target File Extension (must include wildcard "*")
  myExtension = "*.xls"
'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    'Get next file name
      myFile = Dir
  Loop
'Message Box when tasks are completed
  MsgBox "Task Complete!"
  
End Sub
 
Sort by date Sort by votes
Hi Fluff, did you manage to understand what i meant above?
warradoyle said:
This is what my spreadsheet looks like at the moment. The Populate Start of Period button works perfectly.
2r20kdu.jpg


After reading a bit more into it now and looking at the picture i showed of how its supposed to look ive come to the conclusion that all i need to alter for the Populate End of Period are these values ive altered below:
Code: 
   With Sheets("Dashboard")
            .Range("[COLOR=#ff0000]I[/COLOR]" & Rwnum).value = MyValue
            .Range("[COLOR=#ff0000]J[/COLOR]" & Rwnum).value = MyInvoicing
            .Range("[COLOR=#ff0000]K[/COLOR]" & Rwnum).value = MyCost
            .Range("[COLOR=#ff0000]Q[/COLOR]" & Rwnum).value = foreCastedValue
            .Range("[COLOR=#ff0000]R[/COLOR]" & Rwnum).value = foreCastedInvoicing
            .Range("[COLOR=#ff0000]S[/COLOR]" & Rwnum).value = foreCastedCost
        End With

This results in the End Of Period columns being populated correctly.

What this code does at the moment from what i understand is pull values from July (H column is July in both Summary tab and Curent Year and Forecast tab). Highlighted in red in the code below.

I believe that now to get this to work fully, rather than pulling it every time from the July column i need to:
Get the date from cell T2 that ive highlighted in red (reporting month) from Finance Dashboard spreadsheet that has my buttons on
Then scan Row 4 from Current Year and Forecast Tab
And if column in row 4 = date from finance Dashboard spreadsheet that has my buttons on
Then use that column to populate. Where ive wrote in green in this code is where i imagine the correct code needs to do to achieve that.

Code: 
Sub LoopAllExcelFilesInFolder2()

    Dim DshBrdSht As Worksheet
    Dim PFR As Workbook
    Dim MyValue As Currency
    Dim MyInvoicing As Currency
    Dim MyCost As Currency
    Dim foreCastedValue As Currency
    Dim foreCastedInvoicing As Currency
    Dim foreCastedCost As Currency
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim Dict As Scripting.Dictionary
    Dim a As Variant
    Dim v As Variant
    Dim Rw As Integer
    Dim Rwnum As Integer
    Dim PrjCode As String

Application.ScreenUpdating = False

     Set DshBrdSht = ActiveSheet

'Create dictionary & populate it with Project Names & relevant row numbers
        Set Dict = CreateObject("Scripting.Dictionary")
        a = Range("B12", Range("B12").End(xlDown))

        With Dict
            .comparemode = vbTextCompare
            Rw = 11
            For Each v In a
                Rw = Rw + 1
    '            If Not IsEmpty(v) Then
                    If Not .Exists(v) Then .Add v, Rw
    '            End If
            Next
        End With

     myPath = "T:\Project\ADCIS\PFRs\"
'Target File Extension (must include wildcard "*")
     myExtension = "*.xls"
'Target Path with Ending Extention
     myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
     Do While myFile <> ""
'Set variable equal to opened workbook
        Set PFR = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=0)
' Get Project name & Row number
        PrjCode = "CO0" & Left(myFile, 7)
        If Dict.Exists(PrjCode) Then
            Rwnum = Dict.Item(PrjCode)
        Else
            Rwnum = DshBrdSht.Range("B" & Rows.Count).End(xlUp).Offset(1).Row
            DshBrdSht.Range("B" & Rwnum).value = PrjCode
        End If

        With PFR.Sheets("Summary")
      [COLOR=#00ff00]  'GET  date from foreCast spreadsheet from cell T2
        'Then scan row 4 from current year and forecast tab AND IF  column row 4 = date from forecast spreadsheet THEN   use that columm to  populate[/COLOR]
            [COLOR=#ff0000]MyValue = .Range("H43").value 'copy cells required h43 into value
            MyInvoicing = .Range("H45").value 'copy h45 into invoicing
            MyCost = Excel.WorksheetFunction.Sum(.Range("H40,H42")) 'copy sum of h42 and h40 into Cost
        End With[/COLOR]

  [COLOR=#ff0000]      With PFR.Sheets("Current Year & Forecast")
            foreCastedValue = .Range("H16").value 'copy 16 into value
            foreCastedInvoicing = .Range("H17").value 'copy 17 into invoicing
            foreCastedCost = .Range("H15").value 'copy 15 into Cost[/COLOR]
        End With
        PFR.Close 'close the file

        With Sheets("Dashboard")
            .Range("I" & Rwnum).value = MyValue
            .Range("J" & Rwnum).value = MyInvoicing
            .Range("K" & Rwnum).value = MyCost
            .Range("Q" & Rwnum).value = foreCastedValue
            .Range("R" & Rwnum).value = foreCastedInvoicing
            .Range("S" & Rwnum).value = foreCastedCost
        End With


'Get next file name
        myFile = Dir
    Loop
'Message Box when tasks are completed
      MsgBox "Start Of Period Values Successfully Populated"

Application.ScreenUpdating = True

End Sub

Ive attached the Summary and Current Year and Forecast tabs below again:
Summary:
2inl80.jpg


Current Year and Forecast:
141x7s.jpg


Thanks for the help once again Fluff over the past couple of days with my first attempt at VBA here!
Click to expand...
 
Upvote 0

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Hi Fluff, did you manage to understand what i meant above?
Click to expand...
Mornin
I did understand you, I've just been a tad busy.
I've always found working with dates can be somewhat problematical. so could you initially run the following code, having changed the workbook.open line to match one of your files.
Code: 
Sub ChkDate()

    Dim StrtDt As Date
    Dim EndDt As Date

    StrtDt = Sheets("Dashboard").Range("T2").Value
    Workbooks.Open ("[COLOR=#ff0000]T:\Project\ADCIS\PFRs\...[/COLOR]")
    EndDt = Sheets("Current Year & Forecast").Range("H4")

    If Month(StrtDt) = Month(EndDt) Then
        MsgBox "OK"
    Else
        MsgBox "Not OK" & vbLf & StrtDt & vbLf & EndDt
    End If


End Sub
 
Upvote 0
Awesome mate. I'll go give it a whirl.


Fluff said:
Mornin
I did understand you, I've just been a tad busy.
I've always found working with dates can be somewhat problematical. so could you initially run the following code, having changed the workbook.open line to match one of your files.
Code: 
Sub ChkDate()

    Dim StrtDt As Date
    Dim EndDt As Date

    StrtDt = Sheets("Dashboard").Range("T2").Value
    Workbooks.Open ("[COLOR=#ff0000]T:\Project\ADCIS\PFRs\...[/COLOR]")
    EndDt = Sheets("Current Year & Forecast").Range("H4")

    If Month(StrtDt) = Month(EndDt) Then
        MsgBox "OK"
    Else
        MsgBox "Not OK" & vbLf & StrtDt & vbLf & EndDt
    End If


End Sub
Click to expand...
 
Upvote 0
Slight change of plan, don't bother with the above. As I've taken a slightly different tack.
This should do the trick, I've highlighted the modified bits in red
Code: 
Sub LoopAllExcelFilesInFolder2()

    Dim DshBrdSht As Worksheet
    Dim PFR As Workbook
    Dim MyValue As Currency
    Dim MyInvoicing As Currency
    Dim MyCost As Currency
    Dim foreCastedValue As Currency
    Dim foreCastedInvoicing As Currency
    Dim foreCastedCost As Currency
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim Dict As Scripting.Dictionary
    Dim a As Variant
    Dim v As Variant
    Dim Rw As Integer
    Dim Rwnum As Integer
    Dim PrjCode As String
    [COLOR=#ff0000]Dim DshDate As String
    Dim PfrRng As Range
    Dim PfrCol As Integer
[/COLOR]
Application.ScreenUpdating = False

    Set DshBrdSht = ActiveSheet
    [COLOR=#ff0000]DshDate = Format(Range("T2").Value, "mmm-yy")[/COLOR]

'Create dictionary & populate it with Project Names & relevant row numbers
        Set Dict = CreateObject("Scripting.Dictionary")
        a = Range("B12", Range("B12").End(xlDown))

        With Dict
            .comparemode = vbTextCompare
            Rw = 11
            For Each v In a
                Rw = Rw + 1
    '            If Not IsEmpty(v) Then
                    If Not .Exists(v) Then .Add v, Rw
    '            End If
            Next
        End With

     myPath = "T:\Project\ADCIS\PFRs\"
'Target File Extension (must include wildcard "*")
     myExtension = "*.xls"
'Target Path with Ending Extention
     myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
     Do While myFile <> ""
'Set variable equal to opened workbook
        Set PFR = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=0)
' Get Project name & Row number
        PrjCode = "CO0" & Left(myFile, 7)
        If Dict.Exists(PrjCode) Then
            Rwnum = Dict.Item(PrjCode)
        Else
            Rwnum = DshBrdSht.Range("B" & Rows.Count).End(xlUp).Offset(1).Row
            DshBrdSht.Range("B" & Rwnum).Value = PrjCode
        End If

        With PFR.Sheets("Summary")
            MyValue = .Range("H43").Value 'copy cells required h43 into value
            MyInvoicing = .Range("H45").Value 'copy h45 into invoicing
            MyCost = Excel.WorksheetFunction.Sum(.Range("H40,H42")) 'copy sum of h42 and h40 into Cost
        End With

        With PFR.Sheets("Current Year & Forecast")
            [COLOR=#ff0000]Set PfrRng = .Rows(4).Find(What:=DshDate)
            If Not PfrRng Is Nothing Then PfrCol = PfrRng.Column[/COLOR]
            foreCastedValue = [COLOR=#ff0000].Cells(16, PfrCol)[/COLOR].Value 'copy 16 into value
            foreCastedInvoicing = [COLOR=#ff0000].Cells(17, PfrCol)[/COLOR].Value 'copy 17 into invoicing
            foreCastedCost = [COLOR=#ff0000].Cells(15, PfrCol)[/COLOR].Value 'copy 15 into Cost
        End With
        PFR.Close 'close the file

        With Sheets("Dashboard")
            .Range("I" & Rwnum).Value = MyValue
            .Range("J" & Rwnum).Value = MyInvoicing
            .Range("K" & Rwnum).Value = MyCost
            .Range("Q" & Rwnum).Value = foreCastedValue
            .Range("R" & Rwnum).Value = foreCastedInvoicing
            .Range("S" & Rwnum).Value = foreCastedCost
        End With


'Get next file name
        myFile = Dir
    Loop
'Message Box when tasks are completed
      MsgBox "Start Of Period Values Successfully Populated"

Application.ScreenUpdating = True

End Sub
 
Upvote 0
That all works.

Im pretty much finished this task now, Thanks for your expert VBA skills. The only column i haven't populated now is the final one seen in the screenshots below:
"Variations to Value" - In Period Value and Outturn Margin.

I think i interpret that to mean:
In Period Value - means Start of Period Project Outturn (value + invoicing + cost) - End of Period Project outturn (value + invoicing + cost).
Outturn Margin - means In Period forecast (value + invoicing + cost) - End of Period (value + invoicing + cost).

Would you agree? Is this a simple task to add to the program to complete this whole think do you think?




14dn47r.jpg


Fluff said:
Slight change of plan, don't bother with the above. As I've taken a slightly different tack.
This should do the trick, I've highlighted the modified bits in red
Code: 
Sub LoopAllExcelFilesInFolder2()

    Dim DshBrdSht As Worksheet
    Dim PFR As Workbook
    Dim MyValue As Currency
    Dim MyInvoicing As Currency
    Dim MyCost As Currency
    Dim foreCastedValue As Currency
    Dim foreCastedInvoicing As Currency
    Dim foreCastedCost As Currency
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim Dict As Scripting.Dictionary
    Dim a As Variant
    Dim v As Variant
    Dim Rw As Integer
    Dim Rwnum As Integer
    Dim PrjCode As String
    [COLOR=#ff0000]Dim DshDate As String
    Dim PfrRng As Range
    Dim PfrCol As Integer
[/COLOR]
Application.ScreenUpdating = False

    Set DshBrdSht = ActiveSheet
    [COLOR=#ff0000]DshDate = Format(Range("T2").Value, "mmm-yy")[/COLOR]

'Create dictionary & populate it with Project Names & relevant row numbers
        Set Dict = CreateObject("Scripting.Dictionary")
        a = Range("B12", Range("B12").End(xlDown))

        With Dict
            .comparemode = vbTextCompare
            Rw = 11
            For Each v In a
                Rw = Rw + 1
    '            If Not IsEmpty(v) Then
                    If Not .Exists(v) Then .Add v, Rw
    '            End If
            Next
        End With

     myPath = "T:\Project\ADCIS\PFRs\"
'Target File Extension (must include wildcard "*")
     myExtension = "*.xls"
'Target Path with Ending Extention
     myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
     Do While myFile <> ""
'Set variable equal to opened workbook
        Set PFR = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=0)
' Get Project name & Row number
        PrjCode = "CO0" & Left(myFile, 7)
        If Dict.Exists(PrjCode) Then
            Rwnum = Dict.Item(PrjCode)
        Else
            Rwnum = DshBrdSht.Range("B" & Rows.Count).End(xlUp).Offset(1).Row
            DshBrdSht.Range("B" & Rwnum).Value = PrjCode
        End If

        With PFR.Sheets("Summary")
            MyValue = .Range("H43").Value 'copy cells required h43 into value
            MyInvoicing = .Range("H45").Value 'copy h45 into invoicing
            MyCost = Excel.WorksheetFunction.Sum(.Range("H40,H42")) 'copy sum of h42 and h40 into Cost
        End With

        With PFR.Sheets("Current Year & Forecast")
            [COLOR=#ff0000]Set PfrRng = .Rows(4).Find(What:=DshDate)
            If Not PfrRng Is Nothing Then PfrCol = PfrRng.Column[/COLOR]
            foreCastedValue = [COLOR=#ff0000].Cells(16, PfrCol)[/COLOR].Value 'copy 16 into value
            foreCastedInvoicing = [COLOR=#ff0000].Cells(17, PfrCol)[/COLOR].Value 'copy 17 into invoicing
            foreCastedCost = [COLOR=#ff0000].Cells(15, PfrCol)[/COLOR].Value 'copy 15 into Cost
        End With
        PFR.Close 'close the file

        With Sheets("Dashboard")
            .Range("I" & Rwnum).Value = MyValue
            .Range("J" & Rwnum).Value = MyInvoicing
            .Range("K" & Rwnum).Value = MyCost
            .Range("Q" & Rwnum).Value = foreCastedValue
            .Range("R" & Rwnum).Value = foreCastedInvoicing
            .Range("S" & Rwnum).Value = foreCastedCost
        End With


'Get next file name
        myFile = Dir
    Loop
'Message Box when tasks are completed
      MsgBox "Start Of Period Values Successfully Populated"

Application.ScreenUpdating = True

End Sub
Click to expand...
 
Upvote 0
Would you agree?
Click to expand...
Not being from a finance background, I haven't got a clue!
However it looks as though there is already a formula in 1, if not both of the top 2 cells. If that is the case, the easiest thing would be to copy them down.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Code path
2
Replies
10
Views
314
Jeffrey Mahoney
Jeffrey Mahoney
R
  • Question Question
Add a code or number at the end of the file name using VBA (Looped)
Replies
3
Views
211
HighAndWilder
H
C
  • Solved
VBA - Save each sheet as new workbook with sheet name ( choose all sheets file from a folder & save the extracted workbooks in a folder )
Replies
9
Views
2K
ceasar47
C
E
  • Question Question
Macro to Pull Summary from Multiple Files
Replies
2
Views
539
dreid1011
dreid1011
R
  • Solved
Loop through Rows
Replies
4
Views
398
rollingzep
R

Forum statistics

Threads
1,225,478
Messages
6,185,228
Members
453,283
Latest member
Shortm88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top