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]

I changed finalRow to Integer, rather Long to Integer. My mistake. I've now amended it & it says Subscript out of range again.

Sorry about this. Is it worth me your emailing you anything again? Maybe the whole folder that it's feeding from?

 

[AFPathfinder]

I already have it working on my setup. Don't be sorry for the errors, its a part of the process when dealing with multiple workbooks on a shared drive. To speed things up, when you encounter an error, try to provide where in the macro the error is occuring.

 

[28creation]

This line -
Set mainReport = Application.Workbooks("Team Overview.xlsx")
Results in

Run-time error '9'


When the same line is -
Set mainReport = Application.Workbooks("Team Overview.xlsm")
it returns a red circle with a white cross & 400 to the right of it. I just changed the file type to xlsm

 

[AFPathfinder]

Sorry, it should have been xlsm. Is xlsm giving you a compile error?

 

[28creation]

No, it's giving me the red circle with the white x & 400 to the right of it.

 

[AFPathfinder]

Lets try it with an error handler. I've also added a couple other bits to help make the macro a little more robust.

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
    
    ChDrive "P:"

    '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 = ""

    ReDim arrEmp(4, 0)

    'Start Looping through all files in the directory
    Do While oFile <> ""
        
        '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
            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
        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
    
Trap:
    MsgBox Err.Number & ": " & Err.Description
End Sub

 

[28creation]

Thanks for this.

There's no error coming up but no results are feeding through from the other workbooks either.

 

[28creation]

Once I've F8 tabbed through the VBA it comes back with 0:

 

[AFPathfinder]

When it first gets to this line:

Do While oFile <> ""

Is it skipping all the nested lines and going to this line?:

Application.ScreenUpdating = True 'Turn screen updating back on to see values being added to overview workbook

Edit: I just saw this:

oFile = Dir("P:\Coaching\Schemes - Denah\*" & ".xlsm")

I believe you'll probably need to change the extension back to xlsx.

Sorry I keep changing the syntax. My test environment here looks from an xlsm to several other xlsm. I'm just unsuccessfully changing the syntax back to your situation.

 

[28creation]

No, not at all. If goes through the loop 10 times then completes the final bit.

I assumed the 0: means it's bringing back no results but there are results to be feed through.