Info fed from various workbooks to one overview

[28creation]

Hi all,

I've got one overview workbook & several individual workbooks.

I want certain information to feed through to the overview book. I know how to do this but there's a few other bits I want to do....


I want four cells worth of information fed through from workbook #1 & the overview to have the name of workbook #1 (minus the file type) in another cell next to these four cells.

Then as info is fed into the individual workbooks the overview receives the info & adds it below the ones already received, with the name of the relevant file next to it.

Is there any way of doing this either through normal Excel means or with VBA?


Hope you can help.

Thanks, Matt

 

[28creation]

The only workbook being statically referenced is the Overview workbook. Which line is the error occurring on?

It's a run-time 9 error & it comes up on the second loop of the second workbook it's scanning for...

arrEmp(0, n) = Left(Workbooks(oFile).Name, Len(Workbooks(oFile).Name) - 5) 'Load workbook name

 

[28creation]

I've tried this script on a separate file & group of workbooks & it comes up with the same error but worth into the folder. For example on the first folder it comes up on the second workbook, on the second folder it comes up on the 8th workbook.

 

[28creation]

Any luck with this???

Thanks for all your help, you've been amazing. Really appreciate it.

 

[AFPathfinder]

Sorry for the delayed response. I can't seem to recreate the error on my setup, so I'm not sure what the culprit is. Have you tried closing all Excel workbooks and the application, deleting the necessary workbooks, and then reopening the overview and running it? If so, does the error still exist?

The ChDir is my only guess as the possible cause. It seems to work just fine on my setup at home, but I've seen that syntax cause problems when referencing network locations on a shared drive. ChDir is a member of the VBA library, so closing Excel and reopening might not do the trick. How often are workbooks in that directory deleted?

 

[28creation]

I moved the workbook that was causing the problem, then the error came up again for another workbook, so I removed that, then an error came up for another one. This happened a couple more times then it eventually ran through the script bringing results back from two workbooks. I removed a total of four workbooks from the folder.

Any ideas?

 

[AFPathfinder]

Try this: go ahead and delete/move any of the workbooks you need to. After the workbooks are as they should be, restart your computer. Then, run it again and see if the error still exists.

 

[28creation]

Still the same error.

 

[AFPathfinder]

Does the error always occur on a workbook that is no longer there? I've added an error handler to weed out the RTE 9, but it hasn't been fully tested since I'm not having the RTE 9 on my example. Give it a shot and see where we stand.

Sub Run_Update()
    Dim mainReport As Workbook
    Dim arrEmp() As Variant
    Dim oFile As String
    Dim finalRow As Long
    Dim i As Long
    Dim n As Long
    
    On Error GoTo Trap
    
    Application.ScreenUpdating = False 'Turn off screen updating to speed up macro

    ReDim arrEmp(4, 0)
    
    ChDrive "C:"
    ChDir "[COLOR=#333333]P:\Coaching\Schemes - Denah[/COLOR]"

    'Change this line to the directory that contains the workbooks
    oFile = Dir("[COLOR=#333333]P:\Coaching\Schemes - Denah[/COLOR]\*.xlsm")

    'Load workbook object of Overview workbook into variable
    Set mainReport = Application.Workbooks("Team Overview.xlsm")

    'Find the last used row in column B and load to variable
    finalRow = Cells(Rows.Count, 2).End(xlUp).Row
    
    'Delete the old data in the Overview workbook
    If finalRow > 7 Then Range("B8:J" & finalRow).Value = ""

    'Start Looping through all files in the directory
    Do While oFile <> ""
        If Right(oFile, Len(mainReport.Name)) <> mainReport.Name Then
            Workbooks.Open Filename:=oFile, UpdateLinks:=False, ReadOnly:=True 'Open file
            finalRow = Workbooks(oFile).Sheets("Feedback Log").Cells(Rows.Count, 2).End(xlUp).Row 'Find last row in column B
            If finalRow > 7 Then
                If Not arrEmp(0, 0) = "" Then
                    ReDim Preserve arrEmp(4, UBound(arrEmp, 2) + finalRow - 7) 'Expand 2nd dimension of the array to hold the new data
                End If
                For i = 8 To finalRow 'Loop through the rows
                    arrEmp(0, n) = Workbooks(oFile).Name  'Load workbook name
                    arrEmp(1, n) = Workbooks(oFile).Sheets("Feedback Log").Range("B" & i).Value 'Load column B data in the row to array
                    arrEmp(2, n) = Workbooks(oFile).Sheets("Feedback Log").Range("D" & i).Value 'Load column D data in the row to array
                    arrEmp(3, n) = Workbooks(oFile).Sheets("Feedback Log").Range("F" & i).Value 'Load column F data in the row to array
                    arrEmp(4, n) = Workbooks(oFile).Sheets("Feedback Log").Range("H" & i).Value 'Load column H data in the row to array
                    If Err.Number = 0 Then n = n + 1 Else Err.Clear 'Increase the 2nd dimension counter for next row
                Next i 'Loop to next row/exit if no more rows
            End If
            Workbooks(oFile).Close SaveChanges:=False 'Close the employee workbook
        End If
        oFile = Dir
    Loop
    
    Application.ScreenUpdating = True 'Turn screen updating back on to see values being added to overview workbook
    
    n = 8 'Turn counter into row marker
    For i = LBound(arrEmp, 2) To UBound(arrEmp, 2) 'Loop through the array and unload the data to the Overview workbook row by row
        Cells(n, 2).Value = arrEmp(0, i)
        Cells(n, 4).Value = arrEmp(1, i)
        Cells(n, 6).Value = arrEmp(2, i)
        Cells(n, 8).Value = arrEmp(3, i)
        Cells(n, 10).Value = arrEmp(4, i)
        n = n + 1
    Next i

    On Error GoTo 0
    Exit Sub
Trap:
    If Err.Number = 9 Then
        Resume Next
    Else
        On Error GoTo 0
        Application.ScreenUpdating = True
        Resume
    End If
End Sub

 

[28creation]

Run-time error '1004':

Application-defined or object-defined error

 

[28creation]

Does the error always occur on a workbook that is no longer there?

No, it occurred when the workbook was there but had no info to feed through AND when other workbooks had information. Weird.