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]

They're still not being imported.

 

[AFPathfinder]

I get the feeling that it's looking at the overview workbook when defining the last row. Let's try a version that defines the workbook and worksheet a little better.

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 <> ""
        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
                    n = n + 1 '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
End Sub

 

[28creation]

WE HAVE PROGRESS!!!!

It loaded all the information through, then I went into some of the individual files to take out some bits that weren't relevant, & now it comes up with the Subscript out of range error.

The second file now loads up, read only.

Weird.

It looked great when it worked though!!

 

[AFPathfinder]

That is good news! I was starting to run out of ideas to try.

For the workbooks opening read only, try switching the "ReadOnly:=True" to "ReadOnly:=False" in the macro. You can also change the "UpdateLinks" parameter to True if you see any issues with data not updating correctly.

On the RTE 9 (Subscript out of range), what is highlighted when you click Debug?

 

[28creation]

On the RTE 9 (Subscript out of range), what is highlighted when you click Debug?

It can't load the workbook name by the looks of it. But it could when I first tried it this morning. Although some of them did come up the xlsm extension included too.

 

[28creation]

Interestingly....

Earlier I removed an example feedback in the first workbook "Allison Pink". I have re-inputted that example feedback & it works again.

Although it does bring up the xlsm extension on three of the workbooks & four others come up with just the first name of the individual.

 

[28creation]

It doesn't like it when there's nothing in the first workbook; just removed it again & again it wouldn't work properly.

 

[AFPathfinder]

For the name issue, you can change:

arrEmp(0, n) = Workbooks(oFile).Name  'Load workbook name

To:

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

That should remove the ".xlsm" from the name and hopefully fix the issue where it's only pulling in the first name. What happens when the first workbook is removed and you run the macro? An error?

 

[28creation]

What happens when the first workbook is removed and you run the macro? An error?

Yep, Subscript out of range again.

The name's are now sorted. Thanks.

 

[AFPathfinder]

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

There is a way to skirt the specific error, but that isn't the proper way to deal with an unknown cause of the error.