Results 1 to 12 of 12
  1. #1
    Silver Lounger
    Join Date
    Dec 2000
    Location
    Northampton, Northamptonshire, England
    Posts
    1,951
    Thanks
    2
    Thanked 1 Time in 1 Post

    Seperate data (Excel 2002)

    Hi Legare

    Kindly gave me this macro to extract data and place it in a new tabs, I have been desperatley trying to adapt it to the spreadsheet attached but to know avail. Can anyone help please?

    Many thanks

    Braddy

    See if this does what you want:


    Public
    Sub Separate()
    Dim oSrc As Worksheet, oTgt As Worksheet
    Dim
    lTgtRow As Long
    Dim oCpyStart As Range, oCpyRange
    As Range, oNxtCell As Range
    Application.ScreenUpdating
    = False
    Set oSrc = Worksheets("Main Data")

    oSrc.Range("A2", Range("D65536").End(xlUp).Offset(0,
    2)).Sort key1:=Range("D2"), _
    Order1:=xlAscending,
    header:=xlNo
    Set oCpyStart = oSrc.Range("D2")

    For Each oTgt In Worksheets
    If oTgt.Name
    <> "Main Data" Then
    oTgt.Cells.Clear

    End If
    Next oTgt
    Do While oCpyStart.Value
    <> ""
    Set oTgt = Nothing
    Set
    oNxtCell = oCpyStart.Offset(1, 0)
    Do While
    oCpyStart.Value = oNxtCell.Value
    Set
    oNxtCell = oNxtCell.Offset(1, 0)
    Loop

    Set oCpyRange = Range(oCpyStart.Offset(0, -3),
    oNxtCell.Offset(-1, 2))
    On Error Resume
    Next
    Set oTgt = Worksheets(oCpyStart.Value)

    On Error GoTo 0
    If oTgt Is Nothing
    Then
    Set oTgt = Worksheets.Add(After:=Worksheets(Worksheets.Count) )

    oTgt.Name = oCpyStart.Value
    End
    If
    oSrc.Range("A1:F1").Copy Destination:=oTgt.Range("A1")

    oCpyRange.Copy Destination:=oTgt.Range("A65536").End(xlUp).Offset (1,
    0)
    oTgt.Cells.EntireColumn.AutoFit

    Set oCpyStart = oNxtCell
    Loop
    oSrc.Activate

    Application.ScreenUpdating = True
    End Sub
    If you are a fool at forty, you will always be a fool

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Seperate data (Excel 2002)

    <P ID="edit" class=small>(Edited by sdckapr on 02-Feb-05 06:37. Added additional comment)</P>Your code listed has carriage returns in many wrong places. Is that the issue? Put the code in VB and fix the lines that are red.

    Steve

  3. #3
    Silver Lounger
    Join Date
    Dec 2000
    Location
    Northampton, Northamptonshire, England
    Posts
    1,951
    Thanks
    2
    Thanked 1 Time in 1 Post

    Re: Seperate data (Excel 2002)

    Hi Steve

    Is this better, this macro needs adjusting to suit the new spreadsheet , I'm not sure if I made that clear.

    Thanks Braddy

    Sub SeperateData()
    Dim strMainSheetName As String
    Dim strBranchName As String
    Dim rngTitle As Range
    Dim rngBranchData As Range
    Dim rngBookmark As Range

    Application.ScreenUpdating = False
    strMainSheetName = ActiveSheet.Name
    Range("D1").Select
    ActiveCell.Sort Key1:=Range("D1"), Order1:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, _
    MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    ActiveCell.Offset(1, 0).Select
    ActiveCell.EntireRow.Insert
    Set rngTitle = ActiveCell.Offset(-1, 0).CurrentRegion
    ActiveCell.Offset(2, 0).Select
    Do Until ActiveCell.Value = ""
    If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
    ActiveCell.Offset(1, 0).Select
    Else
    strBranchName = ActiveCell.Offset(-1, 0).Value
    ActiveCell.EntireRow.Insert
    Set rngBookmark = ActiveCell
    Set rngBranchData = ActiveCell.Offset(-1, 0).CurrentRegion
    Sheets.Add
    ActiveSheet.Move After:=Sheets(Sheets.Count)
    ActiveSheet.Name = strBranchName
    rngTitle.Copy Destination:=ActiveSheet.Range("A1")
    rngBranchData.Copy Destination:=ActiveSheet.Range("A2")
    Cells.Columns.AutoFit
    Sheets(strMainSheetName).Select
    rngBookmark.Offset(2, 0).Select
    End If
    Loop
    ActiveCell.Offset(-1, 0).Select
    strBranchName = ActiveCell.Value
    Set rngBookmark = ActiveCell
    Set rngBranchData = ActiveCell.CurrentRegion
    Sheets.Add
    ActiveSheet.Move After:=Sheets(Sheets.Count)
    ActiveSheet.Name = strBranchName
    rngTitle.Copy Destination:=ActiveSheet.Range("A1")
    rngBranchData.Copy Destination:=ActiveSheet.Range("A2")
    Cells.Columns.AutoFit
    Sheets(strMainSheetName).Select
    Columns("A:A").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
    Range("A1").Select
    Application.ScreenUpdating = True
    End Sub
    If you are a fool at forty, you will always be a fool

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

    Re: Seperate data (Excel 2002)

    Does the code in the attached text file do what you want?

  5. #5
    Silver Lounger
    Join Date
    Dec 2000
    Location
    Northampton, Northamptonshire, England
    Posts
    1,951
    Thanks
    2
    Thanked 1 Time in 1 Post

    Re: Seperate data (Excel 2002)

    Hi Hans

    Yes it does in another spreadsheet with different columns, but I have not got the knowledge to adjust it to suit the spreadsheet I attached.

    Many thanks

    Braddy
    If you are a fool at forty, you will always be a fool

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

    Re: Seperate data (Excel 2002)

    So what do you expect from us?

  7. #7
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Seperate data (Excel 2002)

    What do you want the macro to do?
    What is the current macro doing that it shouldn't?
    What is the current macro not doing that it should?

    Steve

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

    Re: Seperate data (Excel 2002)

    I just ran the macro on the workbook you attached to your original message, and it appears to work just as you said you wanted. I have attached the workbook where I ran the macro. Is this not what you wanted?
    Legare Coleman

  9. #9
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Ankeny, Iowa, USA
    Posts
    298
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Seperate data (Excel 2002)

    Braddy,

    I wonder if you didn't realize Hans attached new code in his post? His code does do what you had requested in your original post.

    - Brett

  10. #10
    Silver Lounger
    Join Date
    Dec 2000
    Location
    Northampton, Northamptonshire, England
    Posts
    1,951
    Thanks
    2
    Thanked 1 Time in 1 Post

    Re: Seperate data (Excel 2002)

    Hi Legare

    Your quite right both the code you and Hans supplied did what I require, I have discovered I did not put the header row in, after I put the header row in it did not transfer the header row but moved it down to the bottom row of the sheet. I changed the references to from H1 to H2 but it did not work. I have attached the sheet with the header row so that you can see what I mean.

    thank you for your patience

    Braddy
    If you are a fool at forty, you will always be a fool

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

    Re: Seperate data (Excel 2002)

    You must also specify that the sort must leave the header row alone, and reintroduce copying the header row to the worksheets. See attached text file.

  12. #12
    Silver Lounger
    Join Date
    Dec 2000
    Location
    Northampton, Northamptonshire, England
    Posts
    1,951
    Thanks
    2
    Thanked 1 Time in 1 Post

    Re: Seperate data (Excel 2002)

    Hi Hans

    Sorry I took so long to reply, but as usual your help is invaluable, I now have what I need,
    I was trying to adapt the code to a new spreadsheet but I come unstuck when the column I want to seperate is different to the one in your code.

    Once again my grateful thanks.

    Braddy
    If you are a fool at forty, you will always be a fool

Posting Permissions

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