I have a spreadsheet that contains a control list of all volunteers on a
given day for a not-for-profit. The first worksheeet has all individuals
listed by area where they are volunteering. I have to provide the leader of
each area with a list of his/her volunteers. The categories are in column
"K." Both the number of volunteers and number of cateogories changes daily. I
would like the macro to provide a separate tab for each category. I found
some code to create separate sheets for each horizontal page break. But that
doesn't help as the number of volunteers per area varies. But if someone
could explain how to clear all existing page breaks and insert them based on
change in category, I can make it work.

Thanks for your help.

Hi Andy,

You can use this to remove all present sheets and create a new serie.
You must be sure to use this only when you are on the sheet with all
info.

Sub SheetForEachCategory()
Dim wsTest As Worksheet
Dim wsActive As Worksheet
Dim sTemp As String

Set wsActive = ActiveSheet
' remove all existing catagorysheets
Application.DisplayAlerts = False
For Each wsTest In ActiveWorkbook.Worksheets
If wsTest.Name < wsActive.Name Then
wsTest.Delete
End If
Next
Application.DisplayAlerts = True

' create new catagorysheets
Range("K1").Select
Do
sTemp = ActiveCell.Value

On Error Resume Next
Set wsTest = Worksheets(sTemp)
On Error GoTo 0
If wsTest Is Nothing Then
ActiveWorkbook.Worksheets.Add After:=wsActive
ActiveSheet.Name = sTemp
End If
wsActive.Activate
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell)

End Sub


Hoop this helps


Executor

Thank you.

It works great.

Andy

"Executor" wrote:

Hi Andy,

You can use this to remove all present sheets and create a new serie.
You must be sure to use this only when you are on the sheet with all
info.

Sub SheetForEachCategory()
Dim wsTest As Worksheet
Dim wsActive As Worksheet
Dim sTemp As String

Set wsActive = ActiveSheet
' remove all existing catagorysheets
Application.DisplayAlerts = False
For Each wsTest In ActiveWorkbook.Worksheets
If wsTest.Name < wsActive.Name Then
wsTest.Delete
End If
Next
Application.DisplayAlerts = True

' create new catagorysheets
Range("K1").Select
Do
sTemp = ActiveCell.Value

On Error Resume Next
Set wsTest = Worksheets(sTemp)
On Error GoTo 0
If wsTest Is Nothing Then
ActiveWorkbook.Worksheets.Add After:=wsActive
ActiveSheet.Name = sTemp
End If
wsActive.Activate
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell)

End Sub


Hoop this helps


Executor