Page 1 of 2 12 LastLast
Results 1 to 15 of 18
  1. #1
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Automate break-out of data (2003)

    I have a user w/a spreadsheet that has column headings in row 1. Data is entered in the other rows. Lacking adequate VBA skiills and being a good typist, I take the spreadsheet each month and break-out the data as noted below. When there were only 4 categories, the process wasn't too bad. Now that there are 8 and it is likely to grow to 12+ shortly. A macro would obviously be nice. Here's the process I need to duplicate:

    1. Filter the sheet based on column 1, row 1 (a category, of which there are now 8)
    2. Copy the data
    3. Move to a blank sheet
    4. Paste Special a few times to not only get the data for this category into the new sheet, but also to preserve the formatting and column width, etc.
    5. Change the tab name to the category name
    6. Go back to step 1 for the next category and repeat the process.

    Probably fairly easy for someone with good VBA skills. Thanks in advance for any help on this...

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Automate break-out of data (2003)

    See the threads starting at <post:=471,056>post 471,056</post:>, <post:=413,678>post 413,678</post:> and <post:=380,545>post 380,545</post:>.

  3. #3
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Automate break-out of data (2003)

    If you can't get it working from the links Hans posted for you, then if you will post a sample workbook that shows what the data looks like and can be used for testing, we will help you get what you need.
    Legare Coleman

  4. #4
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Re: Automate break-out of data (2003)

    Thanks to both of you. I almost have it. I've mixed some of the data from the other person's sample file with some fake data of my own and attached the file here.
    I've made minor changes to the Macro (my limited knowledge...I don't think I've messed it up too much)...

    (a) I'd like to avoid having the original sheet sorted by column 1 or put back in the original order if possible.
    ([img]/forums/images/smilies/cool.gif[/img] I obviously missed something when I messed w/the VBA as I'm not getting the last bit of data.

    Thanks.

  5. #5
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Re: Automate break-out of data (2003)

    The macro provided by Hans in the last post he referenced seems to do the trick for me -- however, is there a way to force the colum widths to be the same as they are in the original sheet?

  6. #6
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Automate break-out of data (2003)

    This should do the trick. See attached book with your data.
    <pre>Option Explicit

    Sub Split()
    ' Get a list of unique items in column A
    Dim c As Range, cItems As Collection
    Set cItems = New Collection
    For Each c In ActiveSheet.UsedRange.Columns(1).Cells
    On Error Resume Next ' Ignore duplicates
    If c.Row <> 1 Then cItems.Add c.Text, c.Text
    Next c

    ' For each item, create a sheet and copy the data
    Dim s As Variant, sTab As String
    Dim ws As Worksheet, wsCurrent As Worksheet
    Set wsCurrent = ActiveSheet
    sTab = wsCurrent.Name
    For Each s In cItems
    Set ws = Worksheets.Add(After:=Sheets(sTab))
    ws.Name = s
    sTab = s
    wsCurrent.Activate
    CopyIt sTab
    Next s

    ' Cleanup
    ActiveSheet.Range("A1").AutoFilter
    End Sub

    Sub CopyIt(s As String)
    ' Auto-Filter s
    ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=s
    ' Copy filtered items
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisib le).copy
    ' Paste column widths
    Sheets(s).Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
    ' Paste data
    Sheets(s).Paste
    End Sub
    </pre>

    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  7. #7
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Automate break-out of data (2003)

    Does the attached do what you want?
    Legare Coleman

  8. #8
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Re: Automate break-out of data (2003)

    Thanks, SammB...fussy: how can I turn off the selection in each of the resulting sheets (maybe position the active cell in each as A1?)?

  9. #9
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Re: Automate break-out of data (2003)

    Yes, perfectly! Thank you.

  10. #10
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Automate break-out of data (2003)

    Wow! 2003 fought me tooth and nail! Just add two lines at the end of the copy routine:
    <pre> Sheets(s).Select
    Range("A1").Select
    </pre>

    Also attached.
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  11. #11
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Re: Automate break-out of data (2003)

    The macro worked perfectly. Now, in the "while we're at it" situation...
    What would be the code and where would I place it in the macro if I wanted "TOTALS" to be in the A column, first available row (i.e., 1+last row with data), and if I wanted totals for, say, columns B and E (even though that doesn't make sense in the earlier sample)? -- Thanks!

  12. #12
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Automate break-out of data (2003)

    I added a sum the currency columns routine. See attached.
    <pre>Private Sub SumCurrency()
    Dim nRows As Long, nCols As Long
    Dim i As Integer
    nRows = ActiveSheet.UsedRange.Rows.Count
    nCols = ActiveSheet.UsedRange.Columns.Count
    For i = 1 To nCols
    With Cells(nRows, i)
    If .Style = "Currency" Then
    .Offset(1, 0).FormulaR1C1 = _
    "=SUM(R[" & -nRows + 1 & "]C:R[-1]C)"
    .Borders(xlEdgeBottom).LineStyle = xlDouble
    End If
    End With
    Next i
    End Sub
    </pre>

    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  13. #13
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Re: Automate break-out of data (2003)

    Thanks again...that does the trick, Legare.../Kevin

  14. #14
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Re: Automate break-out of data (2003)

    Hans, the macro is working just fine. However, I created a button from the forms toolbar and placed that button to the top right of the data (to get it away from the input lines). The button calls the macro. Unfortunately, the button is also copied to one of the new sheets. Is there a way to avoid that?

  15. #15
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Automate break-out of data (2003)

    I don't know what macro you are using, so it is impossible for me to tell.
    As an alternative, you could use a custom toolbar button and/or a keyboard shortcut.

Page 1 of 2 12 LastLast

Posting Permissions

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