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]

'If the file isn't named Overview.xlsx, then open and copy the necessary data to the array
If oFile <> mainReport.Name And Right(oFile, 4) = "xlsx" Then
Workbooks.Open Filename:=oFile, ReadOnly:=True 'Open file
Sheets("Feedback Log").Activate 'Activate the Feedback Log sheet

Is this all correct?

 

[AFPathfinder]

Hmmm. If it's exiting the Do Loop before it runs a single pass, it has to be the "oFile = Dir" line. It will only exit the Do Loop when oFile = "" which means nothing located at "P:\Coaching\Schemes - Denah\" ends with ".xlsm".

I had similar issues trying to get my test version to run correctly, but I kept messing with the directory syntax. The end result is the one you just posted.

 

[AFPathfinder]

'If the file isn't named Overview.xlsx, then open and copy the necessary data to the array
If oFile <> mainReport.Name And Right(oFile, 4) = "xlsx" Then
Workbooks.Open Filename:=oFile, ReadOnly:=True 'Open file
Sheets("Feedback Log").Activate 'Activate the Feedback Log sheet

Is this all correct?

If you are right that all workbooks have xlsm, the If statement should read:

If oFile <> mainReport.Name And Right(oFile, 4) = "xlsm" Then

I'm not sure that the If statement is even needed since oFile is being loaded to look at the xlsm files anyway. Are you still having the problem where it skips the Do Loop?

 

[28creation]

I've changed that xlsx to xlsm

I've done the F8 again & when complete it comes up with this message......

1004: 'Filename.xlsm' could not be found. Check the spelling of the file name, and verify that the file location is correct.

If you are trying to open the file from your list of most recently used files, make sure that the file has not been renamed, moved, or deleted.

 

[28creation]

Also, when doing the F8s to check the macro, it goes from Workbooks.Open Filename:=oFile, to the MsgBox Err.Number at the bottom.

 

[AFPathfinder]

I had the same problem until I added "ReadOnly:=True" parameter to Workbooks.Open. When you get the 1004 RTE, it lists the correct workbook name, right?

 

[28creation]

I had the same problem until I added "ReadOnly:=True" parameter to Workbooks.Open. When you get the 1004 RTE, it lists the correct workbook name, right?

Yes it does. In this case the first file in the directory.

 

[28creation]

I had the same problem until I added "ReadOnly:=True" parameter to Workbooks.Open. When you get the 1004 RTE, it lists the correct workbook name, right?

Where should the ReadOnly part go? Does it matter?


Forget this. Just seen where you mean, & it's included.

 

[AFPathfinder]

OK, I removed the xlsm If statement inside the Do Loop, added the ChDir line after the ChDrive, and set UpdateLinks to False when opening the workbooks. I added the UpdateLinks part since it kept asking the user to update links when the workbooks open. You may want to set this to True if the workbooks need updated prior to pulling the information. Give this a shot and see if we might be on the right path, now.

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
    
    Application.ScreenUpdating = False 'Turn off screen updating to speed up macro

    ReDim arrEmp(4, 0)
    
    ChDrive "P:"
    ChDir "P:\Coaching\Schemes - Denah"

    'Change this line to the directory that contains the workbooks
    oFile = Dir("P:\Coaching\Schemes - Denah\*.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 <> ""
        Workbooks.Open Filename:=oFile, UpdateLinks:=False, ReadOnly:=True 'Open file
        Sheets("Feedback Log").Activate 'Activate the Feedback Log sheet
        finalRow = 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) = ActiveWorkbook.Name  'Load workbook name
                arrEmp(1, n) = Range("B" & i).Value 'Load column B data in the row to array
                arrEmp(2, n) = Range("D" & i).Value 'Load column D data in the row to array
                arrEmp(3, n) = Range("F" & i).Value 'Load column F data in the row to array
                arrEmp(4, n) = Range("H" & i).Value 'Load column H data in the row to array
                n = n + 1 'Increase the 2nd dimension counter for next row
            Next i 'Loop to next row/exit if no more rows
        End If
        ActiveWorkbook.Close SaveChanges:=False 'Close the employee workbook
        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
End Sub

 

[28creation]

Right....

No information is coming through but when I F8 through the macro I can see each file coming up behind it, yet the information I can see isn't being fed the Overview.

Then, because the Overview is in that folder too it tries to open it, but can't of course.