Filter data and export as new workbooks

Balajibenz

Board Regular
Joined
Nov 18, 2020
Messages
56
Office Version
  1. 2013
Platform
  1. Windows
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)).
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

fadee2

Active Member
Joined
Nov 7, 2020
Messages
335
Office Version
  1. 2019
Platform
  1. Windows
try this code in a module in your data worksheet.

VBA Code:
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

Board Regular
Joined
Nov 18, 2020
Messages
56
Office Version
  1. 2013
Platform
  1. Windows
try this code in a module in your data worksheet.

VBA Code:
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

Active Member
Joined
Nov 7, 2020
Messages
335
Office Version
  1. 2019
Platform
  1. Windows
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....
VBA Code:
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.
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,126,983
Messages
5,621,966
Members
415,869
Latest member
LWSkinner

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top