Results 1 to 8 of 8
  1. #1
    5 Star Lounger
    Join Date
    Jan 2001
    Posts
    1,119
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Validation (2003)

    I have the following macro that takes a spreadsheet that has a field that has a list of names and separates the first sheet according to the name and puts each name on its own tab with their data. The field with the names has a drop down list of names (validation) that I have on a spreadsheet called Employees. When a run the macro it removes the names from this spreadsheet. Is there a way to prevent the removal of the names from this spreadsheet?

    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("Sheet1")
    oSrc.Range("A2").CurrentRegion.Sort Key1:=Range("A2"), _
    Order1:=xlAscending, Header:=xlYes
    Set oCpyStart = oSrc.Range("A2")
    For Each oTgt In Worksheets
    If oTgt.Name <> "Sheet1" 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, 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
    oCpyRange.Copy Destination:=oTgt.Range("A2")
    oTgt.Cells.EntireColumn.AutoFit
    Set oCpyStart = oNxtCell
    Loop
    oSrc.Activate
    Application.ScreenUpdating = True
    End Sub

    Thanks for your help......

  2. #2
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Validation (2003)

    Change this line:
    <pre>If oTgt.Name <> "Sheet1" Then
    </pre>

    to this:
    <pre>If oTgt.Name <> "Sheet1" and oTgt.Name <> "Employees" Then</pre>


    HTH
    Regards,
    Rory

    Microsoft MVP - Excel

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

    Re: Validation (2003)

    The loop

    For Each oTgt In Worksheets
    If oTgt.Name <> "Sheet1" Then
    oTgt.Cells.Clear
    End If
    Next oTgt

    clears all sheets except Sheet1. To prevent Employees from being cleared, change the second line to

    If oTgt.Name <> "Sheet1" And oTgt.Name <> "Employees" Then

  4. #4
    5 Star Lounger
    Join Date
    Jan 2001
    Posts
    1,119
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Validation (2003)

    Thank you both - that works fine. I have another request if it is possible - if not - how it is will work fine. Right now it separates each person to its own tab with data but it doesn't copy over the heading from sheet 1 to the other sheets. Is there somewhere in the code where it can do this?

  5. #5
    5 Star Lounger
    Join Date
    Jan 2001
    Posts
    1,119
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Validation (2003)

    Is there a way to increase the entries displayed in the dropdown list of data validation? Right now when you click on the dropdown list, it displays 8 entries but I would like to see the whole list without have to scroll down.

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

    Re: Validation (2003)

    The maximum of 8 displayed entries cannot be changed. If it is imperative to display more, use a combo box from the Forms toolbar or from the Control Toolbox. You can set the number of displayed entries for both.

  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: Validation (2003)

    You could add the line:
    oSrc.Rows(1).Copy Destination:=oTgt.Range("A1")

    Before the line:
    oCpyRange.Copy Destination:=oTgt.Range("A2")

    <img src=/S/whisper.gif border=0 alt=whisper width=29 height=17>
    Your code presumes that "Sheet1" will be the activesheet when the code starts. if this may not be true, change the implicit references to explicit ones:

    oSrc.Range("A2").CurrentRegion.Sort Key1:=<font color=red>oSrc.</font color=red>Range("A2"), _
    Set oCpyRange = <font color=red>oSrc.</font color=red>Range(oCpyStart, oNxtCell.Offset(-1, 0)).EntireRow

    Steve

  8. #8
    5 Star Lounger
    Join Date
    Jan 2001
    Posts
    1,119
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Validation (2003)

    Thanks, that worked.

Posting Permissions

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