Way back in 2016 I created a post on how to create child sheets from a master list and keep that list updated via the pressing of a button. It was a smooth procedure and mostly used the autofilter to do the task of getting the job done. The following is a link to that article:
The following is the sample data set. I have isolated Dept A (orange) as this is the department where we might wish to create a new sheet - however, if there is already a sheet titled “A” then I don’t create a new sheet just add to the existing sheet. The concept is to create a unique sheet with the data relating to the Dept. So a sheet for A, B and C. If any new departments get added then new sheets for these too.
This will effectively make the code a little longer as you need to test for this however it works well.
The following bit of VBA code does two things, it first creates a unique list then it used the advanced filter based on that unique list. The advanced filter is a great tool as it can do the above without the use of copy and paste. It can move data effortlessly between sheets and does it very swiftly.
Option Explicit
Sub AdvFilter()
Dim i As Integer
Dim sh As Worksheet
Set sh = Sheet1 'Master list sheet
sh.[A1:A3000].AdvancedFilter 2, sh.[M1], , 1
For i=2 To sh.Range("M" & Rows.Count).End(xlUp).Row 'Loop for each sheet
sh.[N2] = sh.Range("M" & i)
If Not Evaluate("ISREF('" & CStr(sh.Range("M" & i)) & "'!A1)") Then
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = sh.[N2]
sh.[A1].CurrentRegion.AdvancedFilter 2, sh.[N1:N2], Sheets(CStr(sh.[N2])).[A1]
End If
Sheets(CStr(sh.[N2])).[A1].CurrentRegion.ClearContents
sh.[A1].CurrentRegion.AdvancedFilter 2, sh.[N1:N2], Sheets(CStr(sh.[N2])).[A1]
Next i
sh.Range("M1:M400, N2").ClearContents
sh.Select
End Sub
The code first creates the unique list.
sh.[A1:A3000].AdvancedFilter 2, sh.[M1], , 1
I just chose the first 3000 rows rather than make a dynamic list. The advanced filter will make a list of unique items and place in in column M.
Next the code needs to loop through that unique list so I use a simple For loop to loop from row to till the last used row in Column M.
For i = 2 To sh.Range("M" & Rows.Count).End(xlUp).Row
Next is to check if the sheet exists and this does it efficiently without looping through the sheets.
If Not Evaluate("ISREF('" & CStr(sh.Range("M" & i)) & "'!A1)") Then
The next two steps are to clear the contents and add the data.
Sheets(CStr(sh.[N2])).[A1].CurrentRegion.ClearContents sh.[A1].CurrentRegion.AdvancedFilter 2, sh.[N1:N2], Sheets(CStr(sh.[N2])).[A1]
Finally there is a little bit of a tidy up and the code is finished.
The code above runs really smoothly and cleans some of the helper information up after the procedure has finished running. It is worth noting that I have the name of the department in N1 and this needs to remain as the Advanced Filter needs a heading.
The following is the Excel file which is based on a simple set of data.
