Hello Lalit
I cannot see the complete code. If I go and check the original and paste
the code I get lot of unwanted characters in the code
If you cannot send me in a file then can you please send the code to me as
a text file.
thanks for your time and help
Rashid Khan
On Monday, December 31, 2012 3:09:26 PM UTC+4, Lalit Mohan Pandey wrote:
> Hi Rashid,
>
> Sorry i can't upload file so please follow the given steps:
>
> *Step 1:- First create a sample sheet for output report with all the
> formatting and formula and please make sure it should be for 31 rows as
> *
> *max day in a month is 31.*
> *Step 2:- Press Alt + F11 and Alt + I + M and paste below code *
> *
> *
> *Option Explicit
>
> Sub GetEmployeeAttendance()
>
> Dim wksSht As Worksheet
> Dim wksReport As Worksheet
> Dim rngRange As Range
> Dim varData() As Variant
> Dim varName() As Variant
> Dim varDate() As Variant
> Dim varFinal() As Variant
> Dim lngLoopName As Long
> Dim lngLoopDate As Long
> Dim lngCount As Long
> Const strFormula As String = "=A1 & ""|"" &
> TEXT(B1,""m/d/yyyy"")"
> Const strTmpSht As String = "Temp_Sht"
> Const strDataStartCell As String = "A1"
> Const strFinalDataStartCell As String = "D8"
> Const strReportMonthCell As String = "C2"
> Const strEmpNameCell As String = "C5"
> Const strSampleFileName As String = "Sample"
>
> ReDim varData(0)
>
> With ThisWorkbook.Worksheets("Master")
> Set rngRange =
> .Range(strDataStartCell).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 2)
> varData = rngRange.Value
> End With
>
> If UBound(varData) > 0 Then
>
> Application.DisplayAlerts = False
>
> On Error Resume Next
> Worksheets(strTmpSht).Delete
> On Error GoTo 0: Err.Clear
>
> Set wksSht = Worksheets.Add
> With wksSht
> .Name = strTmpSht
> With .Range(strDataStartCell)
> .Resize(UBound(varData), UBound(varData, 2)).Value =
> varData
> .Resize(UBound(varData), 1).RemoveDuplicates Columns:=1,
> Header:=xlYes
> End With
> varName = Intersect(.Range(strDataStartCell,
> .Cells(.Rows.Count, 1).End(xlUp)), .Range(strDataStartCell,
> .Cells(.Rows.Count, 1).End(xlUp)).Offset(1)).Value
> varName = Application.Transpose(varName)
> With .Range(strDataStartCell)
> .Resize(UBound(varData), UBound(varData, 2)).Value =
> varData
> .Resize(UBound(varData), 1).Offset(, UBound(varData,
> 2)).Formula = strFormula
> .Resize(UBound(varData), 1).Offset(, UBound(varData,
> 2)).Value = .Resize(UBound(varData), 1).Offset(, UBound(varData, 2)).Value
> .Resize(UBound(varData), 1).Offset(, UBound(varData,
> 2)).RemoveDuplicates Columns:=1, Header:=xlYes
> End With
> varDate = .Range(.Range(strDataStartCell).Offset(1,
> UBound(varData, 2)), .Cells(.Rows.Count, UBound(varData, 2) +
> 1).End(xlUp)).Value
> varDate = Application.Transpose(varDate)
> .Cells.Clear
> With .Range(strDataStartCell)
> .Resize(UBound(varData), UBound(varData, 2)).Value =
> varData
> End With
> End With
>
> With wksSht
> Set rngRange = .Range(strDataStartCell).CurrentRegion
> rngRange.Resize(1, 1).Offset(, 7).Formula =
> "=IFERROR(TEXT(SUBTotal(105," & rngRange.Resize(, 1).Offset(, 1).Address(,
> , , 1) & "),""yyyy""), """")" 'Year
> rngRange.Resize(1, 1).Offset(, 8).Formula =
> "=IFERROR(TEXT(SUBTotal(105," & rngRange.Resize(, 1).Offset(, 1).Address(,
> , , 1) & "),""mmmm""), """")" 'Month
> rngRange.Resize(1, 1).Offset(, 9).Formula =
> "=IFERROR(INT(SUBTotal(105," & rngRange.Resize(, 1).Offset(, 1).Address(, ,
> , 1) & ")), """")" 'Date
> rngRange.Resize(1, 1).Offset(, 10).Formula =
> "=IFERROR(SUBTotal(105," & rngRange.Resize(, 1).Offset(, 1).Address(, , ,
> 1) & "), """")" 'Min
> rngRange.Resize(1, 1).Offset(, 11).Formula =
> "=IFERROR(SUBTotal(104," & rngRange.Resize(, 1).Offset(, 1).Address(, , ,
> 1) & "), """")" 'Max
> With rngRange.Resize(1, 2)
> .AutoFilter
> For lngLoopName = LBound(varName) To UBound(varName)
> ReDim varFinal(1 To 31, 1 To 3)
> lngCount = 0
> rngRange.AutoFilter Field:=1,
> Criteria1:=varName(lngLoopName)
> For lngLoopDate = LBound(varDate) To UBound(varDate)
> If varDate(lngLoopDate) Like varName(lngLoopName)
> & "|*" Then
> rngRange.AutoFilter Field:=2,
> Operator:=xlFilterValues, Criteria2:=Array(2, Split(varDate(lngLoopDate),
> "|")(1))
> If rngRange.Resize(1, 1).Offset(, 9).Value <>
> 0 Then
> lngCount = lngCount + 1
> varFinal(lngCount, 1) =
> rngRange.Resize(1, 1).Offset(, 9).Value
> varFinal(lngCount, 2) =
> rngRange.Resize(1, 1).Offset(, 10).Value
> varFinal(lngCount, 3) =
> rngRange.Resize(1, 1).Offset(, 11).Value
> End If
> End If
> Next lngLoopDate
> If varFinal(1, 1) <> "" Then
> On Error Resume Next
> Worksheets(varName(lngLoopName)).Delete
> On Error GoTo 0: Err.Clear
> Worksheets(strSampleFileName).Visible = True
> Worksheets(strSampleFileName).Copy
> After:=Sheets(Worksheets.Count)
> Worksheets(strSampleFileName).Visible =
> xlVeryHidden
> Set wksReport = Sheets(Worksheets.Count)
> With wksReport
> .Name = varName(lngLoopName)
> .Range(strReportMonthCell).Value =
> Format(varFinal(1, 1), "mmmm") & " Attendance Report " & Format(varFinal(1,
> 1), "yyyy")
> .Range(strEmpNameCell).Value = "Employee
> Name: " & .Name
>
> .Range(strFinalDataStartCell).Resize(UBound(varFinal),
> UBound(varFinal, 2)).Value = varFinal
> .Cells.EntireColumn.AutoFit
> End With
> &nb...
> Show
> original<https://groups.google.com/group/excel-macros/msg/e5addad120fe63f2?dmode=source&output=gplain&noredirect>
> *
>
--
Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To post to this group, send email to excel-macros@googlegroups.com.
To unsubscribe from this group, send email to
excel-macros+unsubscr...@googlegroups.com.
Visit this group at http://groups.google.com/group/excel-macros?hl=en.
