Combine Files by Manager 1

[EliseFreedman]

Hi There

I have created two reports for each manager. They come from separate systems so are in separate workbooks. All the Reports are in the same folder. They are listed by Manager Name. So for example in the folder I have got a report PersonA_InspectionStatus and a report PersonA_IncidentStatus. Then There is a report PersonB_InspectionStatus and a report PersonB_IncidentStatus. I want to end up with a report PersonA_ActionStatus which will consist of the spreadsheet from PersonA_InspectionStatus and the Spreadsheet from PersonA_IncidentStatus. Same for Person B, C etc.

So far I have got the code below but im not sure firstly how to list all the names in the report without having to hardcode them and also how to save the mergedreport with the persons name in the title.

Can anyone help?

Sub combineFilesbyManager4()
Dim wb As Workbook, Nwb As Workbook, sh As Worksheet, nmAry As Variant, fName As String, fPath As String
Set sh = ThisWorkbook.Sheets(1) 'Edit sheet name
nmAry = Array("PersonA", "PersonB", "PersonC")
fPath = ThisWorkbook.Path 'Edit path if other workbooks are not in same directory as master.
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
    For i = LBound(nmAry) To UBound(nmAry)
        Set Nwb = Workbooks.Add
        fName = Dir(fPath & "*.xl*")
        Do
            If InStr(fName, "_") <> 0 Then
                If Left(fName, InStr(fName, "_") - 1) = nmAry(i) Then
                    Set wb = Workbooks.Open(fPath & fName)
                    Set sh = wb.Sheets(1)
                    sh.Copy After:=Nwb.Sheets(Nwb.Sheets.Count)
                    ActiveSheet.Name = Left(wb.Name, Len(wb.Name) - 5)
                    wb.Close False
                End If
            End If
            fName = Dir
        Loop While fName <> ""
        Nwb.SaveAs Left(fName, InStr(fName, "_") - 1) & ".xlsx"
        Nwb.Close False
    Next
End Sub

 

[SkipVought]

Elsie,

I have created two reports for each manager. They come from separate systems so are in separate workbooks.

Not necessarily so. I have routinely queried or imported data from multiple sources, all from one workbook.

I really don't understand the need for all those workbooks. I often had lists of recipients, usually eMail addresses. But your procedure could loop thru a list of names, query multiple sources to generate multiple reports for each recipient and send to recipient all from one workbook.




Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[EliseFreedman]

Oops that was a typo. They are two separate worksheets within a master workbook that I’m then querying to get the reports for each manager. Not really sure how to get it so that the filtered data from the two worksheets end up in a single workbook which will have the managers name in the file name

 

[SkipVought]

Rather than this...

nmAry = Array("PersonA", "PersonB", "PersonC")

...make a list/table of Persons on a sheet, and loop thru. If your Persons list is a Structured Table named tPersons with a column named Person, then

Sub combineFilesbyManager4()
Dim wb As Workbook, Nwb As Workbook, sh As Worksheet, nmAry As Variant, fName As String, fPath As String
[b]Dim rPerson as Range[/b]
Set sh = ThisWorkbook.Sheets(1) 'Edit sheet name
nmAry = Array("PersonA", "PersonB", "PersonC")
fPath = ThisWorkbook.Path 'Edit path if other workbooks are not in same directory as master.
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
    [b]For Each rPerson in [tPersons[Person]][/b]
        Set Nwb = Workbooks.Add
        fName = Dir(fPath & "*.xl*")
        Do
            If InStr(fName, "_") <> 0 Then
                If Left(fName, InStr(fName, "_") - 1) = [b]rPerson.Value[/b] Then
                    Set wb = Workbooks.Open(fPath & fName)
                    Set sh = wb.Sheets(1)
                    sh.Copy After:=Nwb.Sheets(Nwb.Sheets.Count)
                    ActiveSheet.Name = Left(wb.Name, Len(wb.Name) - 5)
                    wb.Close False
                End If
            End If
            fName = Dir
        Loop While fName <> ""
        Nwb.SaveAs Left(fName, InStr(fName, "_") - 1) & ".xlsx"
        Nwb.Close False
    Next
End Sub

Just focusing on the Person list. Still have reservations about your workbooks approach, but I probably don't understand what you're doing.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[EliseFreedman]

Thank you so much.

Worked like a dream and given me exactly what I am looking for

 

[SkipVought]

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein