Attempting to open 2 separate directories and loop through the files to gather data to amend to a ma-CodePudding

I am hoping someone could help me with my code. I am pretty sure I am close to solving the issue but I just can't figure out why certain things are happening when the code runs. My goal:

Open up a directory that contains a main document
Open that document and grab the last row position
Open the Workbooks in the second directory containing multiple files with multiple sheets in each workbook.
Open each Workbook in the client(Second) directory and check if cell A33 on each worksheet contains info.
Grab the last row of the client file for the copy range
Copy the data starting at A33 to U(Lastrow) and paste it to the blank row in the main document
Update the new last row position in the main document
Close the document and proceed to the next sheet, if there is no sheet the proceed to the next workbook and go through that workbooks sheets and repeat.

To begin - all of the code runs fine up until the second directory Do While Loop.

The first issue I am having is that my code to assign the value of the last row to a variable is returning an incorrect number.

'Get the last row of the client worksheet currently opened
clientLR = wsClient.Cells(wsClient.Rows.Count, "A").End(xlUp).Row 'Returns incorrect last row number (7)**

The second issue is that my do while function loops before the for each function can get the next file.

'Loop again to the next file in client directory to be opened
Loop 'Can't call next file without looping to do while statement again which opens same document**

'Call the next file in the client directory to be opened
Next file

Here is the full code view.

    Sub sourceFile2()
Call loopThroughFiles("Z:\Filepath\")
End Sub

Sub loopThroughFiles(ByVal path As String)
Dim fso As Object
Set fso = CreateObject("scripting.FileSystemObject")
Dim folder As Object
Set folder = fso.GetFolder(path)
Dim file As Object

Dim wsOverall As Worksheet
Dim wbOverall As Workbook
Dim overallLR As Long
Dim overallFilepath As String
Dim overallFile As String

Dim wbClient As Workbook
Dim clientLR As Long
Dim wsClient As Worksheet
Dim cellValue As String

'Suppress alerts for clipboard prompt bypass   screen updating
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'declare overall file path and file type
overallFilepath = "Z:\Filepath\"
overallFile = Dir(overallFilepath)

'loop through overall file directory
Do While overallFile <> ""

'Open file in overall directory
Set wbOverall = Workbooks.Open(overallFilepath & overallFile)
Set wsOverall = wbOverall.Sheets("Overall")

'Find First Blank Row in overall document
overallLR = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

'Debug.Print overallFile
overallFile = Dir()

'Loop until no files left in directory
Loop

'For each file in the client folder
For Each file In folder.Files

'Loop through the files in client directory until no file is left
Do While file.Name <> ""
DoEvents

'Declare and open the workbook for each file in directory
Set wbClient = Application.Workbooks.Open(path & file.Name)

'For each worksheet in the Client workbook
For Each wsClient In wbClient.Worksheets

'Grab the value of Cell A33 in client workbook to compare
cellValue = Range("A33").Value

'Compare the value of cell A33 in client workbook to make sure it contains data
If cellValue <> "" Then
'Get the last row of the client worksheet currently opened
clientLR = wsClient.Cells(wsClient.Rows.Count, "A").End(xlUp).Row 'Returns incorrect last row number (7)**

'Copy the range all the way to the last row in client worksheet and paste it to the overall documents first blank row
wsClient.Range("A33:U" & clientLR).Copy
wsOverall.Range("A" & overallLR).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

'Update new overall documents last row position
overallLR = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

End If
'Close the current opened workbook
wbClient.Close

'Call the next worksheet in the client file to be copied to the overall document again
Next wsClient

'Loop again to the next file in client directory to be opened
Loop 'Can't call next file without looping to do while statement again which opens same document**

'Call the next file in the client directory to be opened
Next file

'remainder code

'Turn alerts back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

CodePudding user response：

Try this out (untested, but should be close)

Sub sourceFile2()
    Call loopThroughFiles("Z:\Filepath\")
End Sub

Sub loopThroughFiles(ByVal path As String)

    Const OVERALL_PATH As String = "Z:\Filepath\"
    
    Dim folder As Object, file
    Dim wsOverall As Worksheet, wbOverall As Workbook
    Dim overallLR As Long, overallFilepath As String
    Dim overallFile As String, wbClient As Workbook, xlFiles As Collection
    Dim clientLR As Long, wsClient As Worksheet, cellValue As String
    
    overallFile = Dir(OVERALL_PATH & "*.xls*", vbNormal) 'find the "overall" Excel file
    If Len(overallFile) = 0 Then
        MsgBox "No overall file found"
        Exit Sub
    End If
    
    Set xlFiles = AllFiles(path, "*.xls*") 'collect all Excel files in `path`
    If xlFiles.Count = 0 Then
        MsgBox "No files to process", vbExclamation
        Exit Sub
    End If
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set wbOverall = Workbooks.Open(OVERALL_PATH & overallFile)
    Set wsOverall = wbOverall.Sheets("Overall")
    overallLR = SheetLastRow(wsOverall)   1 'next empty row
    
    For Each file In xlFiles
        Set wbClient = Application.Workbooks.Open(file)
        For Each wsClient In wbClient.Worksheets
            cellValue = wsClient.Range("A33").Value '<<< specify worksheet here!
            If Len(cellValue) > 0 Then
                clientLR = SheetLastRow(wsClient)
                If clientLR >= 33 Then
                    With wsClient.Range("A33:U" & clientLR)
                        .Copy
                        wsOverall.Range("A" & overallLR).PasteSpecial _
                              Paste:=xlPasteValuesAndNumberFormats
                        overallLR = overallLR   .Rows.Count
                    End With
                End If
            End If
        Next wsClient
        wbClient.Close savechanges:=False
    Next file
    
    'rest of code...
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

'Return all matching files in `folder` where file name matches `pattern`
Function AllFiles(ByVal folder As String, pattern As String) As Collection
    Dim f
    Set AllFiles = New Collection
    If Right(folder, 1) <> "\" Then folder = folder & "\"
    f = Dir(folder & pattern, vbNormal)
    Do While Len(f) > 0
        AllFiles.Add folder & f
        f = Dir()
    Loop
End Function


'find the last used row in a sheet
Function SheetLastRow(ws As Worksheet) As Long
    Dim f As Range
    Set f = ws.Cells.Find(what:="*", After:=ws.Cells(1), LookAt:=xlPart, _
            LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not f Is Nothing Then
        SheetLastRow = f.Row 'otherwise 0
        Debug.Print "'" & f.Parent.Name & "' in '" & _
                     f.Parent.Parent.Name & "' = " & f.Address
    End If
End Function