Incrementing Excel Sheet Links

[shrek]

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]

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]

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]

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]

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

S

[Jacob Hilderbrand]

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]

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]

You're Welcome

Take Care