Automatically write to another sheet where - arrays

Question

I'm currently using this template to log employee holiday requests
http://office.microsoft.com/en-gb/templates/employee-absence-schedule-TC103987167.aspx
I have added array formulas to give the specific number of days each month that an employee has had a Holiday / Unpaid leave / Sick / Late etc
eg
=SUM(LEN(B5:AF5)-LEN(SUBSTITUTE(B5:AF5,"H","")))/LEN("H")
and combined these totals to get a year overview but I still have to look through the sheets to get a full list of days they have requested and copy out the data.
Is there a formula I can put in so I can make a sheet for each employee that when H appears On sheet January B8-AF8 write sheet month name and the corresponding day and date in row 4.
I'm trying to achieve something like this as an automatic function?
I'm currently unable to post images but if you need me to elaborate please let me know.

Answer 1

If I understand correctly, you want 1 sheet per employee? As far as I know there isn't a way of adding sheets automatically without using some code (VBA or otherwise). If you had the sheets already created then I'm sure that we could come up with a formula.
Anyway, here is some VBA code you can try out...It creates a new workbook to summarize the data in. There isn't any error checking and it assumes that you're running it from the template that you provided. Just add a button that calls EmployeeSummary and it should work.
Type DayOffType
Month As String
DayOfWeek As String
Date As String
Type As String
End Type
Type EmployeeType
Name As String
DaysOff() As DayOffType
NumberOfDaysOff As Long
End Type
Private EmployeeData() As EmployeeType
Private EmployeeCount As Long
Sub EmployeeSummary()
Dim wb As Excel.Workbook
Call ReadSchedule(ThisWorkbook)
Set wb = Workbooks.Add
Call WriteSummary(wb, "H")
End Sub
Sub ReadSchedule(Book As Excel.Workbook)
Dim tbl As Excel.Range
Dim TableName As String
Dim sMonth As String, sDay As String
Dim iMonth As Integer, iDate As Integer
Dim iEmployee As Long, iRow As Long, iCol As Long
For iMonth = 1 To 12
sMonth = MonthName(iMonth)
With Book.Worksheets(sMonth)
TableName = "tbl" & sMonth
Set tbl = .ListObjects(TableName).Range
For iRow = 2 To tbl.Rows.Count - 1
iEmployee = GetEmployee(tbl.Cells(iRow, 1))
For iCol = 2 To tbl.Columns.Count - 1
If tbl.Cells(iRow, iCol) <> vbNullString Then
AddDayOff iEmployee, sMonth, tbl, iRow, iCol
End If
Next
Next
End With
Next
End Sub
Private Function GetEmployee(Name As String)
Dim i As Long
For i = 0 To EmployeeCount - 1
If EmployeeData(i).Name = Name Then Exit For
Next
If i >= EmployeeCount Then
ReDim Preserve EmployeeData(EmployeeCount)
EmployeeData(EmployeeCount).Name = Name
EmployeeCount = EmployeeCount + 1
End If
GetEmployee = i
End Function
Private Sub AddDayOff(Employee As Long, Month As String, Table As Range, Row As Long, Col As Long)
With EmployeeData(Employee)
ReDim Preserve .DaysOff(.NumberOfDaysOff)
With .DaysOff(.NumberOfDaysOff)
.Date = Table.Cells(1, Col)
.DayOfWeek = Table.Cells(0, Col)
.Month = Month
.Type = Table.Cells(Row, Col)
End With
.NumberOfDaysOff = .NumberOfDaysOff + 1
End With
End Sub
Private Sub WriteSummary(Book As Excel.Workbook, Optional AbsenceType As String = "H")
Dim ws As Excel.Worksheet
Dim cell As Excel.Range
Dim i As Long, d As Long
Set ws = Book.Worksheets(1)
For i = 0 To EmployeeCount - 1
With ws
.Name = EmployeeData(i).Name
.Range("A1") = EmployeeData(i).Name
Set cell = .Range("A2")
For d = 0 To EmployeeData(i).NumberOfDaysOff - 1
If EmployeeData(i).DaysOff(d).Type = AbsenceType Then
cell = EmployeeData(i).DaysOff(d).Month
cell.Offset(0, 1) = EmployeeData(i).DaysOff(d).DayOfWeek
cell.Offset(0, 2) = EmployeeData(i).DaysOff(d).Date
Set cell = cell.Offset(1, 0)
End If
Next
End With
Set ws = Book.Worksheets.Add(after:=Book.Worksheets(Book.Worksheets.Count))
Next
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub