macro that can copy each persons’ info in a list to a auto-g
Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 14

Thread: macro that can copy each persons’ info in a list to a auto-g

  1. #1
    Board Regular
    Join Date
    Feb 2002
    Location
    Houston, TX
    Posts
    357
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    From
    http://www.mrexcel.com/board/viewtop...c=4847&forum=2

    On 2002-04-16 12:26, Jay Petrulis wrote:
    On 2002-04-16 11:05, Cosmos75 wrote:
    I have a Worksheet with names (Column A) and info/values to the right (Columns B to E).

    Each names appears more than once.

    Is there a macro that can copy each persons’ info to a auto-generated sheet named after the person?
    Hi,

    Short answer:

    1. Get a list of unique names and add a sheet, then name it the person's name

    a) advanced filter and cycle through the list

    b) loop through the list of names and determine whether the sheet exists or not. If it does, go on, else add the sheet.

    2. Cycle through the data list and add each item to the appropriate sheet. You will match the name in the cell and transfer the data to the relevant sheet.

    These two can/should be separate routines as you will only have to add sheets initially and/or when new people are added.

    Here is a function (adapted from John W. Power Programming book) which can be called to determine if a sheet exists or not.

    --------------------
    Public Function SheetExists(sheetname) As Boolean
    Dim abc As Object
    On Error Resume Next
    Set abc = ActiveWorkbook.Sheets(sheetname)
    If Err = 0 Then SheetExists = True _
    Else SheetExists = False
    End Function
    --------------------

    This should get you started.

    HTH,
    Jay

  2. #2
    Board Regular
    Join Date
    Feb 2002
    Location
    Houston, TX
    Posts
    357
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Here's what I have so far.

    But it doesn't work totally right, I get the first name in my list twice, EVEN after using advanced filter. At least that's how it shows up after the macro runs. So my macro stops, and always give me an extra sheet that has no name (except the default one).

    Sub CreateSheets()

    'Makes sure that the status bar is visible
    Application.DisplayStatusBar = True

    'Enter message for status bar
    Application.StatusBar = "Performing Task!! Please Wait!!"

    'Turn off Screen updating
    Application.ScreenUpdating = False

    Range("A2", Range("A65536").End(xlUp).Address).Select
    RowCounter = Selection.Count

    NameRange = Range("A2", Range("A65536").End(xlUp).Address).Address


    Range(NameRange).AdvancedFilter Action:=xlFilterInPlace, Unique:=True

    Dim SheetName As String


    For i = 2 To RowCounter + 1
    Sheets("Names").Select
    SheetName = Range("A" & i).Value
    Sheets.Add
    ActiveSheet.Select
    ActiveSheet.Name = SheetName
    Next i

    ActiveSheet.ShowAllData



    'Turn on Screen Updating
    '(Happens automatically after a module is finished)
    Application.ScreenUpdating = True

    'Reset the Status Bar
    Application.StatusBar = False

    End Sub


    [ This Message was edited by: Cosmos75 on 2002-04-16 15:37 ]

  3. #3
    MrExcel MVP Jay Petrulis's Avatar
    Join Date
    Mar 2002
    Location
    Chicago, IL USA
    Posts
    2,040
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi,

    Names on sheet "Names" beginning in A2 down the column.

    Delete all sheets except for "Names" and run the Add_Names() macro below.

    Then, run it again after finishing to test that duplicates sheets are not added.

    Of course, save your work before doing all this.

    ------------------
    Option Explicit
    Public Function NameofSheet()
    NameofSheet = Application.Caller.Parent.Name
    End Function

    Public Function SheetExists(sheetname) As Boolean
    Dim abc As Object
    On Error Resume Next
    Set abc = ActiveWorkbook.Sheets(sheetname)
    If Err = 0 Then SheetExists = True _
    Else SheetExists = False
    End Function

    Sub Add_Sheets()
    Dim lastrow As Long, sheettoname As String, x As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    lastrow = Sheets("Names").Cells(Rows.Count, 1).End(xlUp).Row

    For x = 2 To lastrow
    sheettoname = Sheets("Names").Cells(x, 1)
    If SheetExists(sheettoname) = True Then
    ' do nothing
    Else
    Worksheets.Add After:=Sheets(ThisWorkbook.Worksheets.Count)
    ActiveSheet.Name = Sheets("Names").Cells(x, 1).Value
    End If
    Next x
    Sheets("Names").Select
    MsgBox "Done!"
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub
    ----------------------

    HTH,
    Jay

  4. #4
    Board Regular
    Join Date
    Feb 2002
    Location
    Houston, TX
    Posts
    357
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Thanks, Jay!

    Now to try and tackle populating those named sheets with their respective namesakes info....

    Any ideas on why mine doesn't work so well?

    [ This Message was edited by: Cosmos75 on 2002-04-16 15:40 ]

  5. #5
    MrExcel MVP Jay Petrulis's Avatar
    Join Date
    Mar 2002
    Location
    Chicago, IL USA
    Posts
    2,040
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    In your Advanced Filter, start the NameRange at A1, not A2, and you will remove the duplicate first name. You will get the header, but you don't cycle through that when you add/name the sheets, so you should be OK there.

    If I see anything else, I'll let you know.

    I think writing the data to the sheets should be fairly straightforward from here.

    I will look to see if there is anything else I can add.

    Bye,
    Jay

  6. #6
    Board Regular
    Join Date
    Feb 2002
    Location
    Houston, TX
    Posts
    357
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    The data should be OK.

    Probably use something with the structure

    If Cell.Value = ws.name Then
    Sheets(ws.name).Cell("A1") = Cell.Value

    use a loop or For i to ...

    to go in and do it.

    It'll be trial and error for me since I am not good at VBA. have to record macros and changes them use existing macros that I've learned.

    THANKS!

  7. #7
    Board Regular
    Join Date
    Feb 2002
    Location
    Houston, TX
    Posts
    357
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Got it to work! (with Help from Jay pointing out my mistake!) The creating sheets part, that is! Here's the code!

    Sub CreateSheets()

    'Makes sure that the status bar is visible
    Application.DisplayStatusBar = True

    'Enter message for status bar
    Application.StatusBar = "Performing Task!! Please Wait!!"

    'Turn off Screen updating
    Application.ScreenUpdating = False




    NameRange = Range("A1", Range("A65536").End(xlUp).Address).Address

    Range(NameRange).AdvancedFilter Action:=xlFilterInPlace, Unique:=True



    Range("A2", Range("A65536").End(xlUp).Address).Select
    RowCounter = Selection.Count

    Dim sheetname As String


    For i = 2 To RowCounter + 1
    Sheets("Names").Select
    sheetname = Range("A" & i).Value
    Sheets.Add
    ActiveSheet.Select
    ActiveSheet.Name = sheetname
    Next i

    Sheets("Names").Select

    ActiveSheet.ShowAllData



    'Turn on Screen Updating
    '(Happens automatically after a module is finished)
    Application.ScreenUpdating = True

    'Reset the Status Bar
    Application.StatusBar = False

    End Sub

  8. #8
    Board Regular
    Join Date
    Feb 2002
    Location
    Houston, TX
    Posts
    357
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Jay,

    Would yours be faster than mine for a lot of sheets? Why would the faster one be the faster one? (hope that makes sense)

    THANKS!

  9. #9
    MrExcel MVP Jay Petrulis's Avatar
    Join Date
    Mar 2002
    Location
    Chicago, IL USA
    Posts
    2,040
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hard to say. I am looping through the entire range in column A, whereas you are only working with the unique elements, so yours should be faster on that front.

    You should check, though, that you don't keep adding sheets if the macro is run again, or worse, throw an error. Only add the sheet if it doesn't already exist.

    Your code jumps back and forth between worksheets. Delete the following line

    ActiveSheet.Select

    as it is not necessary and would speed it ever so slightly.

    The speed differences should be negligible in any case. Writing to the worksheets shouldn't be slow either.

    The one advantage of my approach would be to do something like the following pseudo code:

    Loop through the names
    if the sheet doesn't exist then
    1) add it
    2) copy the data to the next available row

    if the sheet exists then
    1) copy the data to the next available row

    Only one pass through the data.

    Also, if your Names sheet is also your data sheet, consider doing the following:

    1. Adding new sheets (already done)
    2. Looping through with Autofilter to isolate the names and associated data and copying all of it in one shot.

    This is dependent on how you want your data to fall on the new sheet but would be very fast. I have coded like this before, but it would take a bit to find it.

    Bye,
    Jay



  10. #10
    Board Regular
    Join Date
    Feb 2002
    Location
    Houston, TX
    Posts
    357
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    Jay,

    First of all, THANK YOU for all you help!!

    For i = 2 To RowCounter + 1
    Sheets("Names").Select
    sheetname = Range("A" & i).Value
    Sheets.Add
    ActiveSheet.Select
    ActiveSheet.Name = sheetname
    Next i

    Wouldn'e taking out ActiveSheet.Select make the sheet Names be the active one (since there is Sheets("Names").Select or does adding a sheet make the added sheet the active sheet?

    On my way home, I realiased that looping could take awhile. Proably better to use autofilter and copy the data with the filter on each name. Although I am not sure how to loop through the names. Maybe something like

    For Each ws in Worksheet
    Sheets("Names"),Select
    'Autofilter using ws.name and select. (Not sure of the code, will have to wait till I I get to work and have the use of Excel.
    'Then copy back into the respective sheet
    ws.select.paste

    [ This Message was edited by: Cosmos75 on 2002-04-16 17:37 ]

User Tag List

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
  •  

 

 
DMCA.com