Sub FilterMP()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim Wkbook As Workbook
Dim ColumnTest As String
ThisWorkbook.Sheets("DATA ENTRY").Range("A1").Value = "."
Call SortData
Application.ScreenUpdating = False
Z = MsgBox("Are you ready to import " & ThisWorkbook.Path & "\OpenReport.xml?" & vbNewLine & _
"This is the Punch Origin report from KRONOS that should be converted to .XML" & vbNewLine & _
vbNewLine & _
"This should only be done after the Pay Period has been closed.", vbYesNo)
If Z = vbNo Then
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.StatusBar = ""
Exit Sub
End If
Application.StatusBar = "Formatting the Report"
If Len(Dir(ThisWorkbook.Path & "\OpenReport.xml")) = 0 Then
MsgBox (ThisWorkbook.Path & "\OpenReport.xml" & " does not exist. Please check the file location and try again")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.StatusBar = ""
Exit Sub
End If
Set Wkbook = Workbooks.Open(ThisWorkbook.Path & "/OpenReport.xml")
ActiveSheet.Cells.UnMerge
Application.ScreenUpdating = False
If ActiveSheet.Range("A1").Value = "Punch Date/time" Then
ActiveSheet.Range("F2").Activate
Else
ActiveSheet.Range("F1").Activate
End If
For x = 1 To 5
If ActiveCell.Value = "ID:" Then
Columns(ActiveCell.Column).Delete
x = 5
Else
ActiveCell.Offset(0, 1).Activate
End If
Next x
Application.StatusBar = "Formating the Report"
'Application.ScreenUpdating = True
For x = 1 To ActiveSheet.Range("A65536").End(xlUp).Row
ActiveSheet.Range("B" & x & ":E" & x).Merge
ActiveSheet.Range("G" & x & ":H" & x).Merge
If Len(Application.StatusBar) > 26 Then
Application.StatusBar = "Formating the Report"
Else
If x Mod 100 = 0 Then
Application.StatusBar = Application.StatusBar & "."
End If
End If
Next x
ActiveSheet.Range("C:C").ColumnWidth = 25
ActiveSheet.Range("B2").Activate
Application.StatusBar = "Purging SuperUsers"
For x = 1 To ActiveSheet.Range("A65536").End(xlUp).Row
Do While ActiveCell.Column <= 1
ActiveCell.Offset(0, 1).Activate
Loop
Do While ActiveCell.Column > 4
ActiveCell.Offset(0, -1).Activate
Loop
If ActiveSheet.Cells(ActiveCell.Row, 1).Value Like "*Punch*" Then
Rows(ActiveCell.Row).EntireRow.Delete
Else
If ActiveCell.Value = "SuperUser" Or ActiveCell.Value = "JMULLIGAN" Or ActiveCell.Value Like "*Punch*" Then
Rows(ActiveCell.Row).EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Activate
End If
End If
If Len(Application.StatusBar) > 22 Then
Application.StatusBar = "Purging SuperUsers"
Else
If x Mod 100 = 0 Then
Application.StatusBar = Application.StatusBar & "."
End If
End If
Next x
Dim FileCheck As String
Wkbook.Close True
Application.StatusBar = ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.StatusBar = ""
Call ImportMP
On Error Resume Next
Kill (ThisWorkbook.Path & "/OpenReport.xml")
Kill (ThisWorkbook.Path & "/OpenReport.pdf")
Call Purge1Year
MsgBox ("Import Complete")
End Sub
Sub ImportMP()
Application.StatusBar = "Working on it."
Dim CoworkerNumber, Mgr, MPDate As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.StatusBar = "Sending MP to Tracker"
Application.Calculation = xlCalculationManual
Dim Wkbook, MPwkBook As Workbook
Set MPwkBook = ThisWorkbook
Set Wkbook = Workbooks.Open(ThisWorkbook.Path & "/OpenReport.xml")
Do While ActiveSheet.Range("E2") = ""
ActiveSheet.Range("B2").Activate
If ActiveSheet.Range("E2").Value = "" Then
Range("E:E").EntireColumn.Delete
End If
Loop
For x = 1 To ActiveSheet.Range("A65536").End(xlUp).Row
Do While ActiveCell.Column <= 1
ActiveCell.Offset(0, 1).Activate
Loop
Do While ActiveCell.Column > 4
ActiveCell.Offset(0, -1).Activate
Loop
If ActiveCell.Value = "ID:" Then
ActiveCell.Value = ""
End If
If ActiveCell.Value = "" And ActiveCell.Offset(0, 1).Value <> "" Then ' COWORKER CHECK
CoworkerNumber = ActiveCell.Offset(0, 1).Value
Mgr = ""
MPDate = ""
End If
If ActiveCell.Value <> "" Then ' MP CHECK
Mgr = ActiveCell.Value
If ActiveCell.Column = 1 Then
MPDate = ActiveCell.Offset(0, -ActiveCell.Column).Value
MPDate = Format(MPDate, "short date")
Else
MPDate = ActiveCell.Offset(0, -ActiveCell.Column + 1).Value
MPDate = Left(MPDate, 10)
MPDate = Left(MPDate, InStrRev(MPDate, "/") + 4)
End If
If MPwkBook.Sheets("Data Entry").Range("A65536").End(xlUp).Value <> CoworkerNumber And Format(MPwkBook.Sheets("Data Entry").Range("B65536").End(xlUp).Value, "mm/dd/yyyy") <> Format(MPDate, "mm/dd/yyyy") Or MPwkBook.Sheets("Data Entry").Range("A65536").End(xlUp).Value <> CoworkerNumber And Format(MPwkBook.Sheets("Data Entry").Range("B65536").End(xlUp).Value, "mm/dd/yyyy") = Format(MPDate, "mm/dd/yyyy") Or MPwkBook.Sheets("Data Entry").Range("A65536").End(xlUp).Value = CoworkerNumber And Format(MPwkBook.Sheets("Data Entry").Range("B65536").End(xlUp).Value, "mm/dd/yyyy") <> Format(MPDate, "mm/dd/yyyy") Then
If CoworkerNumber = "" Then
MsgBox ("error")
Else
MPwkBook.Sheets("Data Entry").Range("A65536").End(xlUp).Offset(1, 0).Value = CoworkerNumber
MPwkBook.Sheets("Data Entry").Range("B65536").End(xlUp).Offset(1, 0).Value = MPDate
MPwkBook.Sheets("Data Entry").Range("C65536").End(xlUp).Offset(1, 0).Value = Mgr
End If
End If
End If
If Len(Application.StatusBar) > 40 Then
Application.StatusBar = "Sending MP to Tracker"
Else
If x Mod 50 = 0 Then
Application.StatusBar = Application.StatusBar & "."
End If
End If
ActiveCell.Offset(1, 0).Activate
Next x
'MPwkBook.Save
Wkbook.Close False
Set Wkbook = Nothing
Application.StatusBar = ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.StatusBar = ""
Call SortData2
MsgBox ("All Done!")
End Sub
Sub SortData()
Application.StatusBar = "Restoring Data"
Application.ScreenUpdating = False
If ThisWorkbook.Sheets("DATA ENTRY").FilterMode Then ThisWorkbook.Sheets("DATA ENTRY").ShowAllData
ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Clear
ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
Range("A3:A5613"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
Range("B3:B5613"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
Application.StatusBar = ""
End Sub
Sub SortData2()
ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Clear
ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
Range("E3:E" & ThisWorkbook.Sheets("DATA ENTRY").Range("A65500").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
Range("I3:I" & ThisWorkbook.Sheets("DATA ENTRY").Range("A65500").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
Range("B" & ThisWorkbook.Sheets("DATA ENTRY").Range("A65500").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub ShowLegend()
Legend.Show
End Sub
Sub Purge1Year()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.StatusBar = "Purging Data"
Call SortData
For x = 3 To ThisWorkbook.Sheets("DATA ENTRY").Range("A3").End(xlDown).Row
If ThisWorkbook.Sheets("DATA ENTRY").Range("B" & x).Value <= Date - 365 Then
ThisWorkbook.Sheets("DATA ENTRY").Range("A" & x & ":D" & x).Value = ""
ElseIf ThisWorkbook.Sheets("DATA ENTRY").Range("B" & x).Value <= Date - 90 And IsError(ThisWorkbook.Sheets("DATA ENTRY").Range("I" & x).Value) Then
ThisWorkbook.Sheets("DATA ENTRY").Range("A" & x & ":D" & x).Value = ""
End If
Application.StatusBar = "Purging Data " & x - 2 & " out of " & ThisWorkbook.Sheets("DATA ENTRY").Range("A65000").End(xlUp).Row - 2
Next x
Call SortData
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.StatusBar = "Purge Complete"
'MsgBox ("Purge Complete")
Application.StatusBar = ""
End Sub
Sub PurgeData()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.StatusBar = "Purging Data"
Dim PurgeNumber As Integer
Call SortData
PurgeNumber = InputBox("How many days back to you want to purge?")
If IsNumeric(PurgeNumber) = False Then
Do While IsNumeric(PurgeNumber)
PurgeNumber = InputBox("How many days back to you want to purge?")
Loop
End If
For x = 3 To ThisWorkbook.Sheets("DATA ENTRY").Range("A3").End(xlDown).Row
If ThisWorkbook.Sheets("DATA ENTRY").Range("B" & x).Value <= Date - PurgeNumber Then
ThisWorkbook.Sheets("DATA ENTRY").Range("A" & x & ":D" & x).Value = ""
End If
Application.StatusBar = "Purging Data " & x - 2 & " out of " & ThisWorkbook.Sheets("DATA ENTRY").Range("A65000").End(xlUp).Row - 2
Next x
Call SortData
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.StatusBar = "Purge Complete"
MsgBox ("Purge Complete")
Application.StatusBar = ""
End Sub
Sub MPnotTurnedInReport()
ThisWorkbook.Sheets("MP NOT TURNED IN").Visible = True
ThisWorkbook.Sheets("MP NOT TURNED IN").Activate
End Sub
Sub MPIssuesReport()
ThisWorkbook.Sheets("MP Issues by Cost Center").Visible = True
ThisWorkbook.Sheets("MP Issues by Cost Center").Activate
End Sub
Sub MPMgrReport()
ThisWorkbook.Sheets("MP Issues by MGR").Visible = True
ThisWorkbook.Sheets("MP Issues by MGR").Activate
End Sub
Sub GoToReport()
Test = ActiveSheet.Name
ThisWorkbook.Sheets("REPORT").Activate
ThisWorkbook.Sheets(Test).Visible = False
End Sub
Sub BackToDataEntry()
Test = ActiveSheet.Name
ThisWorkbook.Sheets("DATA ENTRY").Activate
ThisWorkbook.Sheets(Test).Visible = False
End Sub