Filter data and export as new workbooks

[Balajibenz]

Hi,

Can someone help me with below requirement. I have a macro work book with data in the sheet "Source". this data has multiple columns and in the column "N"(which is last column which contains data) i have manager names along with blanks and "NA".

I want to filter each Manager and copy the data to new workbook and save it in (by creating folder named "Reports") in same path as the macro workbook with workbook name as manager name and preavious friday date(eg: Max_12-04-2020(mm/dd/yyyy)).

 

[fadee2]

try this code in a module in your data worksheet.

Private Sub abc()
Dim ans As Integer
Dim wb As Workbook

myvalue = InputBox("Please provide the Manager Name")
lc = Cells(1, Columns.Count).End(xlToLeft).Column
lr = Cells(Rows.Count, 1).End(xlUp).Row

With ActiveSheet
    Range("A:N").AutoFilter Field:=lc, Criteria1:=myvalue
End With

ans = MsgBox("Do you want to create separate File?", vbYesNo + vbQuestion, "Manager Summary")

If ans = vbYes Then
    ActiveSheet.Range("A1:N" & lr).SpecialCells(xlCellTypeVisible).Copy
    Set wb = Workbooks.Add
    wb.Sheets(1).Range("A1").PasteSpecial
    fld = ThisWorkbook.Path & "\Reports"
    If Dir(fld, vbDirectory) = "" Then
        MkDir ThisWorkbook.Path & "\Reports\"
        wb.SaveAs ThisWorkbook.Path & "\Reports\" & myvalue & "_" _
        & Format(Now - Application.WorksheetFunction.Weekday(Now, 16), "mm-dd-yyyy")
    wb.Close
    Else
        wb.SaveAs ThisWorkbook.Path & "\Reports\" & myvalue & "_" _
        & Format(Now - Application.WorksheetFunction.Weekday(Now, 16), "mm-dd-yyyy")
        wb.Close
    End If
    Else
End If
End Sub

Hope this helps.

 

[Balajibenz]

try this code in a module in your data worksheet.

Private Sub abc()
Dim ans As Integer
Dim wb As Workbook

myvalue = InputBox("Please provide the Manager Name")
lc = Cells(1, Columns.Count).End(xlToLeft).Column
lr = Cells(Rows.Count, 1).End(xlUp).Row

With ActiveSheet
    Range("A:N").AutoFilter Field:=lc, Criteria1:=myvalue
End With

ans = MsgBox("Do you want to create separate File?", vbYesNo + vbQuestion, "Manager Summary")

If ans = vbYes Then
    ActiveSheet.Range("A1:N" & lr).SpecialCells(xlCellTypeVisible).Copy
    Set wb = Workbooks.Add
    wb.Sheets(1).Range("A1").PasteSpecial
    fld = ThisWorkbook.Path & "\Reports"
    If Dir(fld, vbDirectory) = "" Then
        MkDir ThisWorkbook.Path & "\Reports\"
        wb.SaveAs ThisWorkbook.Path & "\Reports\" & myvalue & "_" _
        & Format(Now - Application.WorksheetFunction.Weekday(Now, 16), "mm-dd-yyyy")
    wb.Close
    Else
        wb.SaveAs ThisWorkbook.Path & "\Reports\" & myvalue & "_" _
        & Format(Now - Application.WorksheetFunction.Weekday(Now, 16), "mm-dd-yyyy")
        wb.Close
    End If
    Else
End If
End Sub

Hope this helps.

Hi Mate,

That works perfectly mate thank you so much. can you help me with small change. rather than asking users to input Manager name lets say we have got the list of managers in column "R" starting from R1. is it possible to loop through the list and filter the manager in N column export workbooks for each manager present int the list.

 

[fadee2]

Hi Mate,

That works perfectly mate thank you so much. can you help me with small change. rather than asking users to input Manager name lets say we have got the list of managers in column "R" starting from R1. is it possible to loop through the list and filter the manager in N column export workbooks for each manager present int the list.

you are welcome...
for the next part of your query, try....

Private Sub abc()
Dim ans As Integer
Dim wb As Workbook

manlr = Cells(Rows.Count, 18).End(xlUp).Row

For y = 2 To manlr

    myvalue = Cells(y, 18)
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    lr = Cells(Rows.Count, 1).End(xlUp).Row
   
    With ActiveSheet
        Range("A:N").AutoFilter Field:=lc, Criteria1:=myvalue
    End With
   
    ans = MsgBox("Do you want to create separate File?", vbYesNo + vbQuestion, "Manager Summary")
   
    If ans = vbYes Then
        ActiveSheet.Range("A1:N" & lr + 1).SpecialCells(xlCellTypeVisible).Copy
        Set wb = Workbooks.Add
        wb.Sheets(1).Range("A1").PasteSpecial
        fld = ThisWorkbook.Path & "\Reports"
        If Dir(fld, vbDirectory) = "" Then
            MkDir ThisWorkbook.Path & "\Reports\"
            wb.SaveAs ThisWorkbook.Path & "\Reports\" & myvalue & "_" _
            & Format(Now - Application.WorksheetFunction.Weekday(Now, 16), "mm-dd-yyyy")
        wb.Close
        Else
            wb.SaveAs ThisWorkbook.Path & "\Reports\" & myvalue & "_" _
            & Format(Now - Application.WorksheetFunction.Weekday(Now, 16), "mm-dd-yyyy")
            wb.Close
        End If
        Else
    End If
   
    ActiveSheet.Range("A:N").AutoFilter
   
Next y

End Sub

hth...

also, I would suggest adding a sample workbook using the xl2bb addon along with your query, that way it is much easier to understand and suggest solutions for every one trying to help, rather then creating sample data for testing.