Results 1 to 5 of 5
  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 again (Excel 2002)

    Hi

    Hans kindly created this code for me and I have tried to adapt it several times all with no success, this particular code belongs to the attached spreadsheet,
    I was sure I changed all the code as necessary, but I was wrong, I am desperate to be able to do this myself as I get quite a few requests for it, I think my siganature applies to me.

    Braddy

    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("Quarter 2")
    oSrc.Range("A4").CurrentRegion.Sort Key1:=Range("C4"), _
    Order1:=xlAscending, Header:=xlYes
    For Each oTgt In Worksheets
    If oTgt.Name <> "Quarter2" Then
    oTgt.Cells.Clear
    End If
    Next oTgt
    Set oCpyStart = oSrc.Range("C4")
    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, oNxtCell.Offset(-1, 0)).EntireRow
    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("A5:AD5").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
    3 Star Lounger
    Join Date
    Feb 2003
    Posts
    363
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Seperate Data again (Excel 2002)

    Braddy,

    I think you need a pair of parentheses with 2 arguments after the first Offset in the following line:

    Set oCpyRange = Range(oCpyStart.Offset, oNxtCell.Offset(-1, 0)).EntireRow

  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 again (Excel 2002)

    Hi Paul

    Could you explain a little bit further, I can't grasp exactly what you are saying!

    Thanks

    Braddy
    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 again (Excel 2002)

    1. You can't use Range("A4").CurrentRegion, for that will include the cells in row 2 and 3 in the sort area. Instead, use

    oSrc.Range("A4:AD" & oSrc.Range("A65536").End(xlUp).Row)

    or something similar.

    2. Your spelling is inconsistent. You have both "Quarter 2" and "Quarter2" in the code. Only the first is correct (it's the name of the worksheet)

    3. Since your data begin in row 5, you should start in C5 instead of C4:

    Set oCpyStart = oSrc.Range("C5"), otherwise you'll copy the header row to a sheet of its own.

    4. You have an Offset without arguments. Just omit it:

    Set oCpyRange = Range(oCpyStart, oNxtCell.Offset(-1, 0)).EntireRow

    5. You copy row 5 as header row. I think you want row 4, or perhaps rows 1 to 4:

    oSrc.Range("A4:AD4").Copy Destination:=oTgt.Range("A1")

    or

    oSrc.Range("A1:AD4").Copy Destination:=oTgt.Range("A1")

    See attached code.

  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 again (Excel 2002)

    Hi Hans

    Thank you for your reply, I Naively thought it would be a simple as changing the the refrence points, as the spreadsheet is so similar to the one you gave me the last code for except for an
    extra row and the surname being in a different column.

    Please accept 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
  •