Results 1 to 5 of 5
  1. #1
    New Lounger
    Join Date
    Oct 2013
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Extracting Data from Excel Database

    I've got a database with a long list of names, and unique values associated with the names. What I want to do is create one worksheet for each individual, and then copy only their data to a specified range in their worksheet, then proceed to the next individual, copy their data to their worksheet etc.

    This: http://tinyurl.com/mmhvmkz is a link to an example worksheet (in google docs form, note - I am actually using Excel 2010, not google docs).

    I've been able to create all the worksheets through using the following code in a new sheet I called "Employee". All I did to this sheet was remove the duplicate name values so I could have a list of all the names for the worksheets.

    Any help is much appreciated. Thanks in advance.

    Code:
        Sub CreateSheetsFromAList()
        Dim nameSource      As String 'sheet name where to read names
        Dim nameColumn      As String 'column where the names are located
        Dim nameStartRow    As Long   'row from where name starts
         
        Dim nameEndRow      As Long   'row where name ends
        Dim employeeName    As String 'employee name
         
        Dim newSheet        As Worksheet
         
        nameSource = "Employee"
        nameColumn = "A"
        nameStartRow = 1
    
         
        'find the last cell in use
        nameEndRow = Sheets(nameSource).Cells(Rows.Count, nameColumn).End(xlUp).Row
         
        'loop till last row
        Do While (nameStartRow <= nameEndRow)
            'get the name
            employeeName = Sheets(nameSource).Cells(nameStartRow, nameColumn)
             
            'remove any white space
            employeeName = Trim(employeeName)
             
            ' if name is not equal to ""
            If (employeeName <> vbNullString) Then
                 
                On Error Resume Next 'do not throw error
                Err.Clear 'clear any existing error
                 
                'if sheet name is not present this will cause error that we are going to leverage
                Sheets(employeeName).Name = employeeName
                 
                If (Err.Number > 0) Then
                    'sheet was not there, so it create error, so we can create this sheet
                    Err.Clear
                    On Error GoTo -1 'disable exception so to reuse in loop
                     
                    'add new sheet
                    Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
                     
                    'rename sheet
                    newSheet.Name = employeeName
               
                     
                    'paste training material
                    Sheets(employeeName).Cells(1, "A").PasteSpecial
                    Application.CutCopyMode = False
                End If
            End If
            nameStartRow = nameStartRow + 1 'increment row
        Loop
        End Sub

  2. Subscribe to our Windows Secrets Newsletter - It's Free!

    Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    5 Star Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,066
    Thanks
    39
    Thanked 182 Times in 169 Posts
    budh,
    Assuming that the related data is in the same row as the employee name, added is the missing code that copies the employee data from the employees sheet.

    HTH,
    Maud

    Code:
    Sub CreateSheetsFromAList()
    
        Dim nameSource      As String 'sheet name where to read names
        Dim nameColumn      As String 'column where the names are located
        Dim nameStartRow    As Long   'row from where name starts
        Dim nameEndRow      As Long   'row where name ends
        Dim employeeName    As String 'employee name
        Dim newSheet        As Worksheet
        'Set nameSource = Worksheets("Employee")
        nameSource = "Employee"
        nameColumn = "A"
        nameStartRow = 1
        
        'find the last cell in use
        nameEndRow = Worksheets(nameSource).Cells(Rows.Count, nameColumn).End(xlUp).Row
        'loop till last row
        Do While (nameStartRow <= nameEndRow)
            'get the name
            employeeName = Sheets(nameSource).Cells(nameStartRow, nameColumn)
            'remove any white space
            employeeName = Trim(employeeName)
            ' if name is not equal to ""
            If (employeeName <> vbNullString) Then
                On Error Resume Next 'do not throw error
                Err.Clear 'clear any existing error
                'if sheet name is not present this will cause error that we are going to leverage
                Sheets(employeeName).Name = employeeName
                If (Err.Number > 0) Then
                    'sheet was not there, so it create error, so we can create this sheet
                    Err.Clear
                    On Error GoTo -1 'disable exception so to reuse in loop
                     'add new sheet
                    Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
                     'rename sheet
                    newSheet.Name = employeeName
                    '----------------------------------------------------------
                    'NEW CODE ADDED
                    'copy training material
                    Sheets(nameSource).Activate
                    LastCol = ActiveSheet.Cells(nameStartRow, Application.Columns.Count).End(xlToLeft).Column
                    Range(Cells(nameStartRow, 2), Cells(nameStartRow, LastCol)).Select
                    Selection.Copy
                    '-----------------------------------------------------------
                    'NEW CODE ADDED
                    'paste training material
                    Sheets(employeeName).Activate  'NEW
                    Sheets(employeeName).Cells(1, "A").PasteSpecial
                    [a1].Select  'NEW
                    Application.CutCopyMode = False
                End If
            End If
            nameStartRow = nameStartRow + 1 'increment row
        Loop
        End Sub

  4. The Following User Says Thank You to Maudibe For This Useful Post:

    Paras (2013-11-04)

  5. #3
    New Lounger
    Join Date
    Nov 2013
    Posts
    2
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Thanks.

    Thanks Maudibe. The codes work perfectly. I am however trying to take this one step further but I ran into bit of a problem.

    Here is bit of a background on what I am trying to achieve. I have a workbook with 2 sheets:

    Sheet 1: List of names and information associated with it. (eg. list of employees and their dob, weight, height etc)

    Sheet 2: A template which contains the field to enter the employees name, dob etc. The template is setup with vlookup so the program only needs one field to be copied from sheet 1 to the new sheet and vlookup will do the rest.

    Using your codes I want to create a new sheet for each employee with all the associated information using the template.

    So basically the code needs to copy two separate things.
    1. Copy the template to need sheet and name the sheet as per the employee name.
    2. Copy the name of the employee to a distinct cell location.

    I have managed to to do both of these by playing around with your codes but when i copy the template across, it loses some of its formatting like cell sizes and a logo I had on the template.

    So my question is: Is there a way to copy a sheet across without losing any of the formating?

    Thanks.
    Attached Files Attached Files

  6. #4
    5 Star Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,066
    Thanks
    39
    Thanked 182 Times in 169 Posts
    Paras,

    Here is some code that will create a new sheet for each of the names on the master sheet. It will name the sheet to the name of the person and then copy the data to the appropriate cells in column B. The code is activated by a button but you could add this to the Workbook_Open or WorkSheet_Activate event subroutines. If you have the same name in the list, the code will name the sheet "Template(2)" and still continue to run. You will not need the Excel vlookup formulas nor the code that you have in the ThisWorkbook module.

    Hope this is what you are looking for,
    Maud

    Names1.png Names2.png

    Code:
    Public Sub EmployeeSheets()
    On Error Resume Next
    'DECLARE AND SET VARIABLES
    Dim Master As Worksheet
    Set Master = Worksheets("Master")
    LastRow = Master.Cells(Rows.Count, 1).End(xlUp).Row
    '--------------------------------------------------
    'CREATE NEW SHEET AND COPY DATA
    With Master
    For i = 1 To LastRow
        Sheets("Template").Select
        Sheets("Template").Copy After:=Sheets(1) 'CREATE NEW SHEET
        ActiveSheet.Name = .Cells(i, 1).Value  'ASSIGN NAME
        [b4] = .Cells(i, 1) 'COPY DATA
        [b5] = .Cells(i, 2)
        [b6] = .Cells(i, 3)
        [b7] = .Cells(i, 4)
    Next i
    End With
    End Sub
    Attached Files Attached Files

  7. The Following User Says Thank You to Maudibe For This Useful Post:

    Paras (2013-11-05)

  8. #5
    New Lounger
    Join Date
    Nov 2013
    Posts
    2
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Thank you! This is exactly what I was trying to achieve. Your codes are perfect.

    Paras

Tags for this Thread

Posting Permissions

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