PDA

View Full Version : [SOLVED] Incrementing Excel Sheet Links



shrek
01-10-2005, 04:43 AM
Just a quick one as i am sure it's fairly simple however the answer eludes me.

I have a staff holiday and absence worksheet that contain 94 staff over 12 months, each staff record is further linked to an individual record. As you can imagine there is a hideous number of links to create. I am wandering if there is a way to simply link 1 sheet then copy with the link values incremented by 1.

If i have not explained myself clearly enough then please let me know.
i have attached a copy of the two files to give you an idea of why it's not easier.

I realise that the easiest way would be to simply use vlookup to generate the individual report but i have instructions that individual records have to be kept. The design could i guess be changed as long as it fitted on 1 sheet without any tabs. The reason being is that it is used to look at historic patterns.

Any ideas?

S

Jacob Hilderbrand
01-11-2005, 12:22 AM
Maybe this will help you get started. Put this code in the ThisWorkbook code section of "Pod Absence Forumn Example.xls".


Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Cel As Range
Dim CheckDate As Variant
Dim ColOffset As Long
CheckDate = Range(Cells(2, Target.Column).Address).MergeArea(1, 1).Value
If Not IsDate(CheckDate) Then
Exit Sub
End If
With Workbooks("Individual POD Absence Records.xls").Sheets("2005")
Set Cel = .Range("B:B").Find(what:=CheckDate, LookIn:=xlValues, _
LookAt:=xlWhole)
If Not Cel Is Nothing Then
ColOffset = Target.Column - _
Range(Cells(2, Target.Column).Address).MergeArea(1, 1).Column
.Range(Cells(Cel.Row, 3 + ColOffset).Address).Value = Target.Text
End If
End With
End Sub

When somthing is entered into one of the cells on "Pod Absence Forumn Example.xls" it will be transfered to the appropriate spot in "Individual POD Absence Records".

Now since your attachment just has one sheet called "2005" that is where the data will currently be transfered to. Since you have a sheet for each employee I would assume that the sheet has the employee's name as part of the sheet name. If that is the case then you can determine the correct sheet by using the employee name corresponding to the data input.

You can get the employee name like this.


Employee = Cells(Target.Row, 2).Text

Then modify that as needed to match the sheet name (unless the sheet name is exactly the same as the employee name).

shrek
01-11-2005, 03:18 AM
Jacob,

What a fantastic bit of coding, I am however struggling with the linking of the individual sheets.
Have taken a stab at how to get the file name and open it, not not sure if this is right, would you be able to help.


employee_record = Cells(Target.Row, 2).Text
'would get the employee record (filename-as each individual record is saved as the employee number) from entry on row A
Windows(employee_record).Activate
'would open the employee record for writting.

for example the dir could be c:/My documents/employee records
the master file would also be included in this dir. Is this correct or am i way off the mark.

S

Jacob Hilderbrand
01-11-2005, 04:25 AM
Try this macro. It will open the files, add the data, then save and close the files.


Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Cel As Range
Dim CheckDate As Variant
Dim ColOffset As Long
Dim Path As String
Dim Wkb As Workbook
Dim FName As String
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Get the corresponding date based on the input
CheckDate = Range(Cells(2, Target.Column).Address).MergeArea(1, 1).Value
'If there is no date then exit the sub
If Not IsDate(CheckDate) Then
GoTo Canceled:
End If
'Get the corresponding file name based on the input
FName = Cells(Target.Row, 1).Text
'Path of the employee files
Path = "C:\My documents\employee records"
'Open the corresponding workook to add the data
On Error Resume Next
Set Wkb = Workbooks.Open(Filename:=Path & "\" & FName & ".xls")
On Error GoTo 0
'If the workbook cannot be found, exit the sub
If Wkb Is Nothing Then
MsgBox "The workbook named " & FName & ".xls could not be found."
GoTo Canceled
End If
'Add data to the workbook
With Wkb.Sheets("2005")
'Find the row to enter the data based on the date of the data
Set Cel = .Range("B:B").Find(what:=CheckDate, LookIn:=xlValues, _
LookAt:=xlWhole)
'If a matching date is found add the data
If Not Cel Is Nothing Then
ColOffset = Target.Column - _
Range(Cells(2, Target.Column).Address).MergeArea(1, 1).Column
.Range(Cells(Cel.Row, 3 + ColOffset).Address).Value = Target.Text
End If
End With
Wkb.Close SaveChanges:=True
Canceled:
Set Wkb = Nothing
Set Cel = Nothing
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

shrek
01-11-2005, 08:30 AM
Jacob,

Have just had a shot of the code with all 94 entries, everything is working well however the data for each man is only being copied under "S" of the relavent week. I.e. entry for 259 on Tuesday as "H" would show up as "H" under S (sunday) of that week.

I have had a look at the code and the only bit that looks like there may be a problem is the following part line,


Range(Cells(2, Target.Column).Address).MergeArea(1, 1).Column


just wandering if this would force all entries into a particular colum.

Any ideas
:confused:
S

Jacob Hilderbrand
01-11-2005, 06:08 PM
That line is correct, but is was refering to the wrong workbook. Try it with this replacement.


If Not Cel Is Nothing Then
ColOffset = Target.Column - _
Sh.Range(Cells(2, Target.Column).Address).MergeArea(1, 1).Column
.Range(Cells(Cel.Row, 3 + ColOffset).Address).Value = Target.Text
End If

shrek
01-12-2005, 02:45 PM
works perfectly, shows how much i still have to learn.

Many thanks for all the help and annotating the code.

I just hope that some time I can contribute so positively to the forum.

S

Jacob Hilderbrand
01-12-2005, 05:49 PM
You're Welcome :)

Take Care