Consulting

Results 1 to 3 of 3

Thread: Solved: Filtering Values and splitting worksheet according to the values

  1. #1
    VBAX Contributor
    Joined
    Feb 2007
    Posts
    126
    Location

    Cool Solved: Filtering Values and splitting worksheet according to the values

    Hi All,

    I have a worksheet Main Report as attached with 11 Columns.

    11th Column is a "Region", filtering on a region will show all the records in that region.

    My goal is to have a script to loop through all the regions, and for each create a new worksheet and copy into it all relevant records.

    So far I came up with:

    [vba]Selection.AutoFilter Field:=11, Criteria1:="AH-SE"
    sizer = ActiveSheet.UserRange.Rows.Count
    Range("A1:K$" & sizer).Select
    Selection.Copy
    Sheets("Main Report").Select
    Sheets.Add
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "AH-SE"
    ActiveSheet.Paste
    Sheets("Main Report").Select
    Selection.AutoFilter Field:=11, Criteria1:="EPA-TCI"[/vba]

    This works but:

    This method hardcodes names of new pages and filtering criterias... I would much rather have some kind of a loop through all possible criterias (unique values in Column 11) and pages should be named based on criteria...

    I attached my workbook as an example!

    Again, Thanks a lot, greately appreciate your help!!

    Mike

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    Public Sub ProcessData()
    Dim i As Long
    Dim iLastRow As Long
    Dim iNextRow As Long
    Dim cell As Range
    Dim sh As Worksheet

    With ActiveSheet

    iLastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
    For i = 2 To iLastRow 'iLastRow to 1 Step -1
    Set sh = Nothing
    On Error Resume Next
    Set sh = Worksheets(.Cells(i, "K").Value)
    On Error GoTo 0
    If sh Is Nothing Then
    Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    sh.Name = .Cells(i, "K").Value
    .Rows(1).Copy sh.Rows(1)
    iNextRow = 2
    Else
    iNextRow = sh.Cells(sh.Rows.Count, "K").End(xlUp).Row + 1
    End If
    .Rows(i).Copy sh.Rows(iNextRow)
    Next i
    End With

    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Contributor
    Joined
    Feb 2007
    Posts
    126
    Location

    Amazing stuff

    I have years and years to learn Thanks a lot!

    Mike

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •