Jesse,
Here's a complete routine that extracts the individual employee data to the separate preformatted sheets for each employee name contained in the database.
For this routine to work, it requires that you create the following NECESSARY range names used by the routine.
1) "data" - assigned to your database. The top row of this range needs to include unique field names for each of the columns of your database.
2) "out_xxxx" - where you replace "xxxx" with each employee name found in your database and for which you have an individual preformatted sheet. Assign these names to the top row (of field names) in each of the individual employee sheets.
3) "uniq" - See the sub-routine "Extract Unique". This name is assigned to the two cells that contain (define) the criteria for extracting a unique set of names. The first cell must contain the field name used for the column containing the employee names. The cell below must be left empty.
4) "uniq_out" - See the sub-routine "Extract Unique". This name is assigned to the field name used for the names in your database. This field name is on a separate sheet used for receiving a unique list of the names extracted from the database.
5) "crit" - assigned to the two cells that contain (define) the criteria for extracting all data for each employee to their respective sheets. The first cell must contain the field name used for the column containing the employee names. The cell below must contain this formula: =emp_name.
6) "emp_name" - assigned to a separate cell. In this "scaled down" application, this cell can be anywhere. However, in the larger application from which this was extracted, the separate cell was in turn referenced by other criteria and by database formulas used for generating a summary report that provided totals for each employee based on more complex criteria.
Here is the routine...
Sub Extract_Data()
'Extracts individual employee's data to their
'respective sheets.
Application.ScreenUpdating = False
Extract_Unique '- subroutine - see below
Set_Unique '- subroutine - see below
Extract_Names '- subroutine - see below
Application.ScreenUpdating = True
End Sub
Sub Extract_Unique()
'Extracts a UNIQUE set of employee names to the "UniqueList" sheet.
Range("data"
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:="uniq", _
CopyToRange:=Range("uniq_out"
, _
Unique:=True
End Sub
Sub Set_Unique()
'Sorts the Names, and assigns a range name "namelist"
Application.Goto Reference:="uniq_out"
ActiveCell.Offset(1, 0).Select
FirstCell = ActiveCell.Address
LastCell = [A65536].End(xlUp).Address
sortdata = FirstCell & ":" & LastCell
Range(sortdata).Name = "namelist"
Range(sortdata).Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.Goto Reference:="R1C1"
End Sub
Sub Extract_Names()
'Extracts data for each name in the unique list.
'Data is copied to a cell named "emp_name" which is
'referenced by a formula in the criteria named "crit".
For Each c In Range("namelist"
c.Copy ("emp_name"
Ext_Names
Next
End Sub
Sub Ext_Names()
'Extracts the data to the individual sheets.
'Each individual sheet requires a range name of
'"out_xxxx" where xxxx is the name of the employee.
'The range name is assigned to the top row containing
'the field names.
ext = "out_" & Range("int_name"
.Value
Range(ext).Name = "ext_out"
Range("data"
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:="crit", _
CopyToRange:=Range("ext_out"
, _
Unique:=False
End Sub
If you encounter any difficulty, please consider the following...
With much of the assistance I provide, I first develop or modify an existing model to achieve the goals of the described task. I have done so in this case, and I would therefore suggest that it might well be in your interest to ask that I email you this "working model".
The working model should enable you to understand the above MUCH better.
This model ALSO contains a good example of how summary reports can be generated by using Excel's database functions.
I hope this helps.
IMPORTANT: As I'm leaving for vacation tomorrow, I would suggest that if you want the working model, you should ask for it ASAP.
If anyone else would like a copy of this file, please don't hesitate to ask. But please be specific in what file you're asking for, as I receive requests for various files. In this case, ask for the "Violations by Name" file.
Regards, ...Dale Watson
HOME: nd.watson@shaw.ca
