Page 2 of 12 FirstFirst 1234 ... LastLast
Results 11 to 20 of 111

Thread: VBA: Split data into multiple worksheets based on column

  1. #11
    Banned user
    Join Date
    Nov 2010
    Posts
    2,075
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    Quote Originally Posted by fjlaff View Post
    Hi mirabeau,

    Sorry, I meant to say the produced sheet names are in reverse alphabetical order.
    ...
    I don't quite follow you there.
    That code was designed to produce sheets in normal alphabetical order and has always done so for me.

    However, just to try something, in the line

    .Cells(1).Resize(rws, cls).Sort .Cells(cc), 2, Header:=xlYes

    if you change the 2 to 1, does it make any difference to the order of your produced sheets?

  2. #12
    New Member
    Join Date
    Mar 2014
    Posts
    20
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    Quote Originally Posted by mirabeau View Post
    Really depends on the data and the problem.
    You could try this one and see if it works for you
    Code:
    Sub columntosheets() 
    
    Const sname As String = "Sheet1" 'change to whatever starting sheet
    Const s As String = "A" 'change to whatever criterion column
    Dim d As Object, a, cc&
    Dim p&, i&, rws&, cls&
    Set d = CreateObject("scripting.dictionary")
    With Sheets(sname)
        rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        cc = .Columns(s).Column
    End With
    For Each sh In Worksheets
        d(sh.Name) = 1
    Next sh
    
    Application.ScreenUpdating = False
    With Sheets.Add(after:=Sheets(sname))
    Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)
    .Cells(1).Resize(rws, cls).Sort .Cells(cc), 2, Header:=xlYes
    a = .Cells(cc).Resize(rws + 1, 1)
    p = 2
    For i = 2 To rws + 1
        If a(i, 1) <> a(p, 1) Then
            If d(a(p, 1)) <> 1 Then
                Sheets.Add.Name = a(p, 1)
                .Cells(1).Resize(, cls).Copy Cells(1)
                .Cells(p, 1).Resize(i - p, cls).Copy Cells(2, 1)
            End If
            p = i
        End If
    Next i
    Application.DisplayAlerts = False
        .Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End With
    Sheets(sname).Activate
    
    End Sub
    This seems to be REALLY close to what I need. I need help with a couple of tweaks though. I need rows 1:10 to stay the same and be copied to every sheet. And is there any way to keep the column widths and formatting the same in all sheets? Thanks for the help!

  3. #13
    New Member
    Join Date
    Oct 2014
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question Re: VBA: Split data into multiple worksheets based on column

    Hi! What a great macro! It works perfectly for me; except, when the data is parsed out, no parsing is occurring. That is, the macro creates all of the new worksheets and gives the worksheets the appropriate name (values I have in column "A"). However, the entire data set is being copied to each worksheet. Any help is appreciated.

    Quote Originally Posted by waxsublime View Post
    I'm trying to get this code I found (from How to split data into multiple worksheets based on column in Excel?) to work, but it's giving me an error.

    Code:
    Sub parse_data()
        Dim lr As Long
        Dim ws As Worksheet
        Dim vcol, i As Integer
        Dim icol As Long
        Dim myarr As Variant
        Dim title As String
        Dim titlerow As Integer
        vcol = 4
        Set ws = Sheets("Sheet1")
        lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
        title = "A1:I1"
        titlerow = ws.Range(title).Cells(1).Row
        icol = ws.Columns.Count
        ws.Cells(1, icol) = "Unique"
        For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
        ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
        Next
        myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
        ws.Columns(icol).Clear
        For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
        Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
        Sheets(myarr(i) & "").Columns.AutoFit
        Next
        ws.AutoFilterMode = False
        ws.Activate
    End Sub
    Any ideas on how to fix this?

    Thanks!

  4. #14
    New Member
    Join Date
    Mar 2014
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    Quote Originally Posted by johncameronreid View Post
    Hi! What a great macro! It works perfectly for me; except, when the data is parsed out, no parsing is occurring. That is, the macro creates all of the new worksheets and gives the worksheets the appropriate name (values I have in column "A"). However, the entire data set is being copied to each worksheet. Any help is appreciated.

    If I recall correctly, this is where you need the sorting of column A, then for it to copy identical values to the corresponding sheet, until it hits a new value. I will try and have a look for my macro, not sure where it is now.

  5. #15
    New Member
    Join Date
    Nov 2014
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    Hi mirabeau,

    I'm trying to get the code below in this thread to work but i am getting a debug error below in red, please help.

    Code:
    Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 3
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:G1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 7 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub
    Last edited by RoryA; Nov 5th, 2014 at 04:24 AM.

  6. #16
    MrExcel MVP
    Moderator
    RoryA's Avatar
    Join Date
    May 2008
    Location
    UK
    Posts
    33,604
    Post Thanks / Like
    Mentioned
    47 Post(s)
    Tagged
    6 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    What's the error? (you should really declare i as Long, not Integer)

  7. #17
    New Member
    Join Date
    Nov 2014
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    Quote Originally Posted by RoryA View Post
    What's the error? (you should really declare i as Long, not Integer)
    thanks for the replr rory, When i hit debug this line is highlighted "For i = 7 To lrhow do i change it?

  8. #18
    MrExcel MVP
    Moderator
    RoryA's Avatar
    Join Date
    May 2008
    Location
    UK
    Posts
    33,604
    Post Thanks / Like
    Mentioned
    47 Post(s)
    Tagged
    6 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    What is the error message?

  9. #19
    New Member
    Join Date
    Nov 2014
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    Quote Originally Posted by RoryA View Post
    What is the error message?
    The error is runtime error 6 "Overflow"

  10. #20
    MrExcel MVP
    Moderator
    RoryA's Avatar
    Join Date
    May 2008
    Location
    UK
    Posts
    33,604
    Post Thanks / Like
    Mentioned
    47 Post(s)
    Tagged
    6 Thread(s)

    Default Re: VBA: Split data into multiple worksheets based on column

    Like I said, you need to declare i as Long, not Integer.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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