Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Produce a workbook for each employees data in a worksheet
Hello
Each week we run a report of timesheet information and produce that to an Excel file. From week to week the file will have different number of rows of data. It is sorted by employee number. For each employee we want to produce a workbook of that employees data and than end that routine when there is no more rows of data. How can I do this? |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Produce a workbook for each employees data in a worksheet
Try this code. It will open each week a new Timecard work book using the
GetOpenFilename method (A Pop Up window). the code expects a filename for each emplooyee using the Employee number as the fileName in Folder (a variable declared in the macro). Using the Employee number in Column A it will look for a workbook for the employee and if Not will create the workbook. The code will create a worksheet using the year Number as the worksheet name. The code will copy all the employee rows from the weekly timecard sheet to the workbook for each employee. You will need to change the folder name and the worksheet name of the weekly Workbook where the timecard data is located ("TimeCardData"). Sub CopyToEmployees() Folder = "c:\EmployeeTime\" 'Get Weekly Employee Time Data" TimeCardBKName = Application _ .GetOpenFilename("Excel Files (*.xls), *.xls") If TimeCardBK = False Then MsgBox ("Can't Open file - Exiting Macro") Exit Sub End If Set TimeCardBK = Workbooks.Open(Filename:=TimeCardBKName) With TimeCardBK.Sheets("TimeCardData") RowCount = 1 FirstRow = RowCount 'firstrow is the Starting Row 'Of each employee data Do While .Range("A" & RowCount) < "" 'test if last Row of Employyee 'column A contains the employee Number If .Range("A" & RowCount) < _ .Range("A" & (RowCount + 1)) Then 'FirstRow willbe the first row of employee data and 'RowCount will be th elast row of employee data 'get rows of data to copy Set EmployeeRows = _ .Rows(FirstRow & ":" & RowCount) 'set Start row of next Employee FirstRow = Rowcount + 1 EmployeeNo = .Range("A" & RowCount) 'check if Workbook already exists for employee FName = Dir(Folder & EmployeeNo & ".xls") If FName = "" Then 'file doesn't exist creat new workbook Set EmployeeBK = Workbooks.Add EmployeeBK.SaveAs _ Filename:=Folder & Employee & ".xls" 'Name the worksheet by Year EmployeeBK.Sheets("Sheet1").Name = _ "2008" NewRow = 1 Else Set EmployeeBK = Workbooks.Open( _ Folder & FName) End If 'Get this Year worksheet Set EmployeeSht = EmployeeBK.Sheets(Year(Now())) With EmployeeSht If .Range("A1") = "" Then 'If cell A1 is empty then start at row 1 NewRow = 1 Else 'find LastRow LastRow = _ EmployeeSht.Range("A" & Rows.Count) _ .End(xlUp).Row NewRow = LastRow + 1 End If 'copy time information EmployeeRows.Copy Destination:=EmployeeSht.Rows(NewRow) End With End If RowCount = RowCount + 1 Loop End With End Sub "Bud" wrote: Hello Each week we run a report of timesheet information and produce that to an Excel file. From week to week the file will have different number of rows of data. It is sorted by employee number. For each employee we want to produce a workbook of that employees data and than end that routine when there is no more rows of data. How can I do this? |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Produce a workbook for each employees data in a worksheet
Do you want the data to update the employee workbook regular is this a one off?, are you going to run the query manually (click a button) when you want it to run?, are the employee workbooks going to be stored in the same folder? -- The Code Cage Team Regards, The Code Cage Team www.thecodecage.com ------------------------------------------------------------------------ The Code Cage Team's Profile: http://www.thecodecage.com/forumz/member.php?userid=2 View this thread: http://www.thecodecage.com/forumz/showthread.php?t=7526 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Produce a workbook for each employees data in a worksheet
I n oticed that I didn't close the employees workbook which would leave a lot
of open Workbooks. My code requires one minor change from EmployeeRows.Copy Destination:=EmployeeSht.Rows(NewRow) to EmployeeRows.Copy Destination:=EmployeeSht.Rows(NewRow) EmployeeBK.close savechanges:=True "Joel" wrote: Try this code. It will open each week a new Timecard work book using the GetOpenFilename method (A Pop Up window). the code expects a filename for each emplooyee using the Employee number as the fileName in Folder (a variable declared in the macro). Using the Employee number in Column A it will look for a workbook for the employee and if Not will create the workbook. The code will create a worksheet using the year Number as the worksheet name. The code will copy all the employee rows from the weekly timecard sheet to the workbook for each employee. You will need to change the folder name and the worksheet name of the weekly Workbook where the timecard data is located ("TimeCardData"). Sub CopyToEmployees() Folder = "c:\EmployeeTime\" 'Get Weekly Employee Time Data" TimeCardBKName = Application _ .GetOpenFilename("Excel Files (*.xls), *.xls") If TimeCardBK = False Then MsgBox ("Can't Open file - Exiting Macro") Exit Sub End If Set TimeCardBK = Workbooks.Open(Filename:=TimeCardBKName) With TimeCardBK.Sheets("TimeCardData") RowCount = 1 FirstRow = RowCount 'firstrow is the Starting Row 'Of each employee data Do While .Range("A" & RowCount) < "" 'test if last Row of Employyee 'column A contains the employee Number If .Range("A" & RowCount) < _ .Range("A" & (RowCount + 1)) Then 'FirstRow willbe the first row of employee data and 'RowCount will be th elast row of employee data 'get rows of data to copy Set EmployeeRows = _ .Rows(FirstRow & ":" & RowCount) 'set Start row of next Employee FirstRow = Rowcount + 1 EmployeeNo = .Range("A" & RowCount) 'check if Workbook already exists for employee FName = Dir(Folder & EmployeeNo & ".xls") If FName = "" Then 'file doesn't exist creat new workbook Set EmployeeBK = Workbooks.Add EmployeeBK.SaveAs _ Filename:=Folder & Employee & ".xls" 'Name the worksheet by Year EmployeeBK.Sheets("Sheet1").Name = _ "2008" NewRow = 1 Else Set EmployeeBK = Workbooks.Open( _ Folder & FName) End If 'Get this Year worksheet Set EmployeeSht = EmployeeBK.Sheets(Year(Now())) With EmployeeSht If .Range("A1") = "" Then 'If cell A1 is empty then start at row 1 NewRow = 1 Else 'find LastRow LastRow = _ EmployeeSht.Range("A" & Rows.Count) _ .End(xlUp).Row NewRow = LastRow + 1 End If 'copy time information EmployeeRows.Copy Destination:=EmployeeSht.Rows(NewRow) End With End If RowCount = RowCount + 1 Loop End With End Sub "Bud" wrote: Hello Each week we run a report of timesheet information and produce that to an Excel file. From week to week the file will have different number of rows of data. It is sorted by employee number. For each employee we want to produce a workbook of that employees data and than end that routine when there is no more rows of data. How can I do this? |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Produce a workbook for each employees data in a worksheet
See replies
"The Code Cage Team" wrote: Do you want the data to update the employee workbook regular is this a one off?, Weekly runs are you going to run the query manually (click a button) when you want it to run?, Yes...click a button are the employee workbooks going to be stored in the same folder? Yes -- The Code Cage Team Regards, The Code Cage Team www.thecodecage.com ------------------------------------------------------------------------ The Code Cage Team's Profile: http://www.thecodecage.com/forumz/member.php?userid=2 View this thread: http://www.thecodecage.com/forumz/showthread.php?t=7526 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
#N/A via Vlookup to produce name from other worksheet | Excel Worksheet Functions | |||
TO PRODUCE A WORKSHEET WITH LARGE PRINT | Excel Discussion (Misc queries) | |||
produce a formulate to produce assigned seats for dinner | Excel Worksheet Functions | |||
How do I produce a centroid fit to excel data? | Excel Worksheet Functions |