Need macro for Attendance Tracker

[pi_sa11]

Hi,

I wanted to develop a excel macro which should perform below operations. I have attached file for the reference. In sheet "Detail" raw data is placed. In row 7 from data & to date is present which will be a month.

1) Now develop a macro which will insert automatic date in a month in row 1 of the sheet "InTime", "InitialStatus", "ModStatus".

2) Develop a macro which will insert in time, out time & work time in accordance with date, employee name & employee ID in sheet InTime. Please note the structure of the sheet InTime is demo only, as out time & work time columns are not present. you may insert asper your convenience.

3) Write a macro which will insert automatic data of attendance i.e.. P(Present),A(absent) in sheet "InitialStatus" with respect to date, employee name & employee id.

 

[p45cal]

Sub Status()
Set WorkSht = Sheets("Detail")
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Set Destn = NewSht.Range("A3")
With NewSht
  .Range("C1").Value = 1
  .Range("C1").DataSeries Rowcol:=xlRows, Type:=xlLinear, Stop:=31
  .Range("A2:B2").Value = Array("EmployeeName", "EmployeeID")
  .Range("C2:AG2").Value = "Status"
End With
With WorkSht.Columns(1)
  Set c = .Find("Empcode :", lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
  If Not c Is Nothing Then
    firstAddress = c.Address
    Do
      Set myDataRng = c.Range("B1,D1,B12:AF12")
      Destn.Value = myDataRng.Areas(2).Value  'name
      Destn.Offset(, 1).Value = myDataRng.Areas(1).Value  'empcode
      Destn.Offset(, 2).Resize(, 31).Value = myDataRng.Areas(3).Value
      Set Destn = Destn.Offset(1)
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
End With
End Sub


Sub InTime()
Set WorkSht = Sheets("Detail")
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Set Destn = NewSht.Range("A3")
With NewSht
  .Range("C1").Value = 1
  .Range("C1").DataSeries Rowcol:=xlRows, Type:=xlLinear, Stop:=31
  .Range("A2:B2").Value = Array("EmployeeName", "EmployeeID")
  .Range("C2:AG2").Value = "InTime"
End With
With WorkSht.Columns(1)
  Set c = .Find("Empcode :", lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
  If Not c Is Nothing Then
    firstAddress = c.Address
    Do
      Set myDataRng = c.Range("B1,D1,B5:AF5")
      Destn.Value = myDataRng.Areas(2).Value  'name
      Destn.Offset(, 1).Value = myDataRng.Areas(1).Value  'empcode
      With Destn.Offset(, 2).Resize(, 31)
        .Value = myDataRng.Areas(3).Value
        .NumberFormat = "hh:mm"
      End With
      Set Destn = Destn.Offset(1)
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
End With
End Sub