Right now I am able to group all the data together based on the first column, then put each of those groups onto their own sheets. Now I want to only put certain groups on new sheets.
For Example.
"Data Sheet"
Bob 12
Fred 72
Bob 83
Joe 98
Mary 34
Joe 45
Sarah 66
"Usable List Sheet"
Fred
Bob
Joe
So if the name from "Data Sheet" occurs in "Usable List Sheet", group like names and put on new sheet.
The result would be
"Bob sheet"
Bob 12
Bob 83
"Fred Sheet"
Fred 72
"Joe Sheet"
Joe 98
Joe 45
Here is my code that groups EVERY like Assigned_TO and puts EVERY grouping onto new sheets. Please help me modify my existing code.
Sub NewSheet()
Dim DataSH As Worksheet, WrkSH As Worksheet, NewSH As Worksheet
Dim SiteRNG As Range
Application.ScreenUpdating = False
Set DataSH = Sheets("Data")
'create header row
Rows("1:1").Insert shift:=xlDown
Range("A1:G1").Value = Array("Assigned_TO", "Product_Seg", "X_City", "X_State", "5 Digit Zip Code", "Last Name", "Tier")
'create working sheet, and build unique list of site IDs
Set WrkSH = Sheets.Add
WrkSH.Range("A1").Value = "Assigned_TO"
WrkSH.Range("C1").Value = "Assigned_TO"
DataSH.Range("A:G").AdvancedFilter Action:=xlFilterCopy, copytorange:=WrkSH.Range("A1"), unique:=xlYes
'determine the list of unique site IDs to process
Set SiteRNG = WrkSH.Range(WrkSH.Range("A2"), WrkSH.Range("A2").End(xlDown))
'process each site id, and use advanced filter to copy to new output sheet
For Each ce In SiteRNG
WrkSH.Range("C2").Value = ce.Value
Set NewSH = Sheets.Add(after:=Sheets(Sheets.Count))
NewSH.Name = ce.Value
NewSH.Range("A1:G1").Value = Array("Assigned_TO", "Product_Seg", "X_City", "X_State", "5 Digit Zip Code", "Last Name", "Tier")
DataSH.Range("A:G").AdvancedFilter Action:=xlFilterCopy, criteriarange:=WrkSH.Range("C1:C2"), copytorange:=NewSH.Range("A1:G1")
Next ce
'delete the worksheet
Application.DisplayAlerts = False
WrkSH.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Bookmarks