1

I hope you can help. I have made an attempt to code this myself (see code below) but failed so I am reaching out to the community for assistance.

What I need my code to do is allow a user to click on a command button, then the user selects a folder. Once this folder is selected. I need the code to look or loop through this folder and all the subfolders in this folder and find sheets with a name Like "CustomerExp" then copy the the data in sheets name Like "CustomerExp" from the second row down to the last used row and paste the information into a sheet called "Disputes" where the macro is housed.

I have supplied pictures for better understanding.

Pic 1 is where the macro is housed and where i need the info pasted to.

Pic 1 enter image description here

Pic 2 is the first file the user will select and the only one i want them to select

Pic 2

enter image description here

Pic 3 you can see that in folder 2017 there are several other folders

Pic 3 enter image description here

Pic 4 Again you can see that we have the file I am looking for plus more folders that need to be looped through

Pic 4

enter image description here

Essentially what I need the code to do is allow the person to select 2017 folder click ok and then the code goes through everything in the 2017 folder finds the files with names Like "CustomerExp" copies data and pastes to the sheet "Disputes" in the sheet where the macro is held.

My code compiles but its not doing anything. As always any and all help is greatly appreciated.

MY CODE

Sub AllWorkbooks()

    Dim MyFolder As String 'Path collected from the folder picker dialog
    Dim myFile As String 'Filename obtained by DIR function
    Dim wbk As Workbook 'Used to loop through each workbook
    Dim FSO As New FileSystemObject ' Requires "Windows Script Host Object Model" in Tools -> References
    Dim ParentFolder As Object, ChildFolder As Object

    Dim wb As Workbook
    Dim myPath As String    
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim lRow As Long
    Dim ws2 As Worksheet
    Dim y As Workbook

    On Error Resume Next
    Application.ScreenUpdating = False

    'Opens the folder picker dialog to allow user selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False

        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
            Exit Sub
        End If    
        MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
    End With

    myFile = Dir(MyFolder) 'DIR gets the first file of the folder        

    Set y = ThisWorkbook
    Set ws2 = y.Sheets("Disputes")

    'Loop through all files in a folder until DIR cannot find anymore
    Do While myFile <> ""

        If myFile Like "*CustomerExp*" Then                                
            'Opens the file and assigns to the wbk variable for future use
            Set wbk = Workbooks.Open(Filename:=MyFolder & myFile)
            'Replace the line below with the statements you would want your macro to perform
            With wb.Sheets(1)
                lRow = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A2:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
            End With

            Application.Wait (Now + TimeValue("0:00:05"))
            wbk.Close savechanges:=True            
        End If
        myFile = Dir 'DIR gets the next file in the folder                               
    Loop

    For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders
        myFile = Dir(MyFolder & ChildFolder.Name) 'DIR gets the first file of the folder
        'Loop through all files in a folder until DIR cannot find anymore
        Do While myFile <> ""

        If myFile Like "*CustomerExp*" Then            
            'Opens the file and assigns to the wbk variable for future use
            Set wbk = Workbooks.Open(Filename:=MyFolder & ChildFolder.Name & "\" & myFile)
            'Replace the line below with the statements you would want your macro to perform
            With wb.Sheets(1)
                lRow = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A2:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
            End With

            Application.Wait (Now + TimeValue("0:00:05"))
            wbk.Close savechanges:=True
        End If
        myFile = Dir 'DIR gets the next file in the folder
    Loop
Next ChildFolder

Application.ScreenUpdating = True

End Sub
Community
  • 1
  • 1
Philip Connell
  • 651
  • 5
  • 25
  • 53
  • This is too big a chunk to chew. I suggest you write code to loop through a folder you pick and all its subfolders. Ask any questions to ask on that subject. Then extend the code to list all workbooks in each folder: ask questions about that until it works. Third step, open each workbook and close those you don't want to keep. You can ask questions about that subject. Finally, you arrive at what to do with those workbooks you didn't yet close. There may be one or two programming steps in that section. – Variatus Apr 10 '17 at 09:22
  • Rather than asking the user to select the correct folder (they could get it wrong) you could get the code to pick the folder based on the date: `"\\bedata005\Operations\Rejections All Markets\" & Year(Date) & "\" & Format(Date, "mmm") & "\"`. You'll need to add code to select the correct year/month based on the date - does it take last months data? – Darren Bartrup-Cook Apr 10 '17 at 10:03
  • 1
    Maybe I'm too tired, but you set `Set wbk = Workbooks.Open(Filename:=MyFolder & myFile)`, and the line after `With wb.Sheets(1)` , shouldn't it be `With wbk.Sheets(1)` , also the following line should be `lRow = .Range("A" & .Rows.Count).End(xlUp).Row` – Shai Rado Apr 10 '17 at 10:06
  • Hi Darren: Cheers for taking the time to respond: Unfortunately I don't want the user to select dates. I just want to compile or gather all the Customer Expense Data in the 2017 folder and put it into the Disputes Worksheet. :-) – Philip Connell Apr 10 '17 at 10:08
  • Shai: Tired or not you were right. The code is now bringing in the copied data but it is only doing this for one folder, it is still not moving to the other folders to find "*CustomerExp*" files. Thank you for the help its a big piece of the puzzle. – Philip Connell Apr 10 '17 at 10:13

1 Answers1

1

Just couple of minor issues in your code:

1. With wb.Sheets(1) should be With wbk.Sheets(1)

followed by

lRow = .Range("A" & Rows.Count).End(xlUp).Row should be lRow = .Range("A" & .Rows.Count).End(xlUp).Row

as already pointed out by @ShaiRado in comments

You have to make above changes at two places. First in

Do While myFile <> ""


Loop

and then again in do while loop inside for each loop

For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders

Do While myFile <> ""


Loop

Next ChildFolder

2. myFile = Dir(MyFolder & ChildFolder.Name) should be myFile = Dir(MyFolder & ChildFolder.Name & "\")

Mrig
  • 11,612
  • 2
  • 13
  • 27
  • Hi Mrig: Boo Yaah!! That did the trick amazingly. The Excel force is strong with you my friend. Thank you so much for taking the time to respond, It has greatly help me today. Much respect from Dublin :-) Thank you again. – Philip Connell Apr 10 '17 at 11:20
  • @PhilipConnell - You are welcome. Glad I could help. – Mrig Apr 10 '17 at 11:26