Extracting Data from Excel Database

Topic

New Reply

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

Reply | Quote

Replies

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
                [COLOR=”#008000″]’———————————————————-[/COLOR]
                [COLOR=”#008000″]’NEW CODE ADDED[/COLOR]
                [COLOR=”#008000″]’copy training material[/COLOR]
                Sheets(nameSource).Activate
                LastCol = ActiveSheet.Cells(nameStartRow, Application.Columns.Count).End(xlToLeft).Column
                Range(Cells(nameStartRow, 2), Cells(nameStartRow, LastCol)).Select
                Selection.Copy
                [COLOR=”#008000″]’———————————————————–[/COLOR]
                [COLOR=”#008000″]’NEW CODE ADDED[/COLOR]
                ‘paste training material
                Sheets(employeeName).Activate  [COLOR=”#008000″]’NEW[/COLOR]
                Sheets(employeeName).Cells(1, “A”).PasteSpecial
                [a1].Select  [COLOR=”#008000″]’NEW[/COLOR]
                Application.CutCopyMode = False
            End If
        End If
        nameStartRow = nameStartRow + 1 ‘increment row
    Loop
    End Sub

Reply | Quote

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.

Reply | Quote

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

35360-Names1 35361-Names2

Code:

Public Sub EmployeeSheets()
On Error Resume Next
[COLOR=”#008000″]’DECLARE AND SET VARIABLES[/COLOR]
Dim Master As Worksheet
Set Master = Worksheets(“Master”)
LastRow = Master.Cells(Rows.Count, 1).End(xlUp).Row
[COLOR=”#008000″]’————————————————–
‘CREATE NEW SHEET AND COPY DATA[/COLOR]
With Master
For i = 1 To LastRow
    Sheets(“Template”).Select
    Sheets(“Template”).Copy After:=Sheets(1) [COLOR=”#008000″]’CREATE NEW SHEET[/COLOR]
    ActiveSheet.Name = .Cells(i, 1).Value  [COLOR=”#008000″]’ASSIGN NAME[/COLOR]
    [b4] = .Cells(i, 1) [COLOR=”#008000″]’COPY DATA[/COLOR]
    [b5] = .Cells(i, 2)
    [b6] = .Cells(i, 3)
    [b7] = .Cells(i, 4)
Next i
End With
End Sub

Reply | Quote

Thank you! This is exactly what I was trying to achieve. Your codes are perfect.

Paras

Reply | Quote