A VBA Excel Macro that processes an Excel Table with a category column (must be first column) and applies several sorts, filters and styling. Also it creates a linked table of contents of worksheets in the excel workbook.

Category to Sheet

Sub CategoryToSheet()
    Dim rng                 As Range
    Dim Category            As Range
    Dim List                As New Collection
    Dim Item                As Variant
    Dim i                   As Integer
    Dim rngLinkCell         As Range
    Dim strSubAddress       As String
    Dim strDisplayText      As String
    '
    ' Set the Field we want to Filter by (In this case the 5th column)
    ' Dim SortField           As String: SortField = 5
    '
    'Some Titles for each catgorized worksheet.
    Dim Title               As String: Title = "Categorized Keywords"
    Dim Source              As String: Source = "www.tikodigital.com"
    Dim PullDate            As String: PullDate = "5/20/2012"
    '
    ' We are going to work with a bunch of worksheets let's create some.
    Dim Sh                  As Worksheet
    Dim Sheet               As Worksheet
    Dim ShNew               As Worksheet
    Dim ShTableOfContents   As Worksheet
    '
    ' If you want to see changes happen on screen as the code runs
    ' Screen Updating = True, Leaving it false speeds things up
    ' as the screen doens't have to render.
    Application.ScreenUpdating = True
    '
    ' Set the source worksheet
    Set Sh = Worksheets("Sheet1")
    '
    ' Add A Worksheet to the Workbook called Table of Contents
    Set ShTableOfContents = Worksheets.Add
    ShTableOfContents.Name = "Table of Contents"
    '
    ' Set Range to the first column of the table.
    Set rng = Sh.ListObjects(1).ListColumns(1).DataBodyRange
    ' Loop throught the first column of the list and
    ' create a list of categories from unique values in the list.
    On Error Resume Next
    For Each Category In rng
        List.Add Category.Value, CStr(Category.Value)
    Next Category
    On Error GoTo 0
    '
    ' Reuse the range variable and change the data range to
    ' the entire ListObject (A.K.A. an Excel Table)
    Set rng = Sh.ListObjects(1).Range
    '
    ' Lets's loop through the list of categories
    For Each Item In List
        '
        'Create a new worksheet For the List item
        Set ShNew = Worksheets.Add
        '
        ' The "With" command tells VBA to use the current new Worksheet
        ' It's just a shortcut so we don't have tow rewrite ShNew every
        ' time we refence the New Sheet.
        With ShNew
            '
            ' Give the new sheet the name of the category.
            .Name = Left(Item, 30)
            '
            ' Excel tables are aweome because they make filtering and sorting data easy
            ' Let's add filtering to each new table - Forexample I wonly want to see
            ' the top 40 keywords by Google Result and do some basic formatting.
            ' and remove the first auto generated column that is just going to contain the
            ' the category name in every row
   
            rng.AutoFilter _
                Field:=1, _
                Criteria1:=Item
            rng.SpecialCells(xlCellTypeVisible).Copy .Range("A1")
      
            rng.AutoFilter
             .ListObjects.Add(xlSrcRange, ShNew.UsedRange, , xlYes).Name = Item
            .ListObjects(Item).TableStyle = "TableStyleLight9"
            .ListObjects(Item).Range(1, 1).Select
            .ListObjects(Item).ListColumns(1).Range.Delete
            '.ListObjects(Item).Range.AutoFilter Field:=SortField - 1, Criteria1:="10", Operator:=xlTop10Items
            .ListObjects(Item).Range.Columns.AutoFit
            .ListObjects(Item).ListColumns(2).Range.ColumnWidth = "40"
            '
            ' Let's add some fields above the Table to add some nice titles and style them
            For i = 1 To 8
                .Rows(1).EntireRow.Insert
            Next i
            .Columns("A").EntireColumn.Insert
            .Columns("A").ColumnWidth = 5
            .Range("B2").Value = Title
            .Range("B2").Font.Size = 14
            .Range("B2").Font.Bold = True
            .Range("B3").Value = "Category:"
            .Range("C3").Value = Item
            .Range("B4").Value = "Source:"
            .Range("C4").Value = Source
            .Range("B5").Value = "Date of Pull:"
            .Range("C5").NumberFormat = "@"
            .Range("C5").Value = PullDate
            '
            ' Let's add a link to the Table of Contents on each sheet
            .Hyperlinks.Add Anchor:=.Range("B7"), _
            Address:="", SubAddress:="'" & "Table of Contents" & "'!A1", _
            TextToDisplay:="Return to Table of Contents"
            '
            ' Turn off the gridlines on each new sheet.
            ' You don't need training wheels do you?
            ActiveWindow.DisplayGridlines = False
            
            ' ############################################################################################
            '
            '   GW:     A bonus block of code for formatting the Active Sheet for printing
            '           this really slows down processing the data. I thought it would be
            '           because you can automate so much repetitve work.
            '
            ' ############################################################################################
            '
            '            Dim n As Integer: n = .ListObjects(Item).Range.Cells.Count
            '            .PageSetup.PrintArea = "$A$1:" & .ListObjects(Item).Range.Cells(n).Address
            '            .PageSetup.LeftHeader = ""
            '            .PageSetup.CenterHeader = ""
            '            .PageSetup.RightHeader = ""
            '            .PageSetup.LeftFooter = ""
            '            .PageSetup.CenterFooter = ""
            '            .PageSetup.RightFooter = ""
            '            .PageSetup.LeftMargin = Application.InchesToPoints(0.5)
            '            .PageSetup.RightMargin = Application.InchesToPoints(0.5)
            '            .PageSetup.TopMargin = Application.InchesToPoints(0.5)
            '            .PageSetup.BottomMargin = Application.InchesToPoints(0.5)
            '            .PageSetup.HeaderMargin = Application.InchesToPoints(0.5)
            '            .PageSetup.FooterMargin = Application.InchesToPoints(0.5)
            '            .PageSetup.PrintHeadings = False
            '            .PageSetup.PrintGridlines = False
            '            .PageSetup.PrintComments = xlPrintNoComments
            '            .PageSetup.PrintQuality = 600
            '            .PageSetup.CenterHorizontally = False
            '            .PageSetup.CenterVertically = False
            '            .PageSetup.Orientation = xlLandscape
            '            .PageSetup.Draft = False
            '            .PageSetup.PaperSize = xlPaperLetter
            '            .PageSetup.FirstPageNumber = xlAutomatic
            '            .PageSetup.Order = xlDownThenOver
            '            .PageSetup.BlackAndWhite = False
            '            .PageSetup.Zoom = False
            '            .PageSetup.FitToPagesWide = 1
            '            .PageSetup.FitToPagesTall = 1
            '            .PageSetup.PrintErrors = xlPrintErrorsDisplayed
            '
            ' ###########################################################################################
     
        End With
    Next Item
    
    
    '
    ' For Each worksheet in the Entire Workbook Loop through create a
    ' Hyperlink to the Worksheet in the Table of Contents
    For Each Sheet In ActiveWorkbook.Worksheets
        Set rngLinkCell = ShTableOfContents.Range("A" & Rows.Count).End(xlUp)
        If ShTableOfContents.Range("A1") = "" Then
            Set rngLinkCell = Worksheets("Table of Contents").Range("A1")
            End If
            If rngLinkCell <> "" Then Set rngLinkCell = rngLinkCell.Offset(1, 0)
            strSubAddress = "'" & Sheet.Name & "'!A1"
            strDisplayText = Sheet.Name
            
            Worksheets("Table of Contents").Hyperlinks.Add _
            Anchor:=rngLinkCell, _
            Address:="", _
            SubAddress:=strSubAddress, _
            TextToDisplay:=strDisplayText
    Next Sheet
    
    '
    ' Move the Table of Content to make it the First Worksheet in the Workbook
    With ShTableOfContents
         .Move Before:=Worksheets(1)
        For i = 1 To 3
            .Rows(1).EntireRow.Insert
        Next i
               '
    ' Let's add some fields above the Table of Content to add some nice titles and style them
        .Columns("A").EntireColumn.Insert
        .Range("B2").Value = "Table of Contents"
        .Range("B2").Font.Size = 14
        .Range("B2").Font.Bold = True
        .Activate
    End With
    '
    ' Turn Off those Damn Gridlines
    ActiveWindow.DisplayGridlines = False
End Sub