marshybid
05-29-2008, 05:42 AM
Hi All,
xld, this is the complete macro as previously discussed.
I have a report that I run weekly and I need to perform a number of filters and create a number of worksheets and pivots.
Currently this is very slow and also does not do all that I need. I have attached an example spreadsheet.
Private Function PTSubtotals(ByRef PTField As PivotField)
PTField.Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
End Function
Sub Timesheets()
'
' Timesheets Macro
' Timesheet Filter 4/22/2008 by Richard Francis
'
Dim myWorkBook As Workbook
Dim myBaseWorkSheet As Worksheet
Dim myBaseRange As Range
Dim myBaseRow As Range
Dim RowsCounter As Long
'Dim StartDate As Date
'
'On Error Resume Next
' StartDate = Application.InputBox("Enter start date", Type:=2)
' On Error GoTo 0
' If StartDate > 0 Then
'
' Else
'
' End If
Application.ScreenUpdating = False
'// Add required columns and formulas
ActiveSheet.Name = "Timesheet Details"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Order ID"
Range("A1:AR1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.Bold = True
Selection.AutoFilter
Range("A1").Select
Columns("Y:Y").Select
Selection.Insert Shift:=xlToRight
Range("Y1").Select
ActiveCell.FormulaR1C1 = "Timesheet For Week Ending"
Range("Y2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1))"
Range("Y2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
Columns("AS:AS").Select
Selection.Insert Shift:=xlToRight
Range("AS1").Select
ActiveCell.FormulaR1C1 = "Approved in Week Ending"
Range("AS2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1))"
Range("AS2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
Columns("AT:AT").Select
Selection.Insert Shift:=xlToRight
Range("AT1").Select
ActiveCell.FormulaR1C1 = "Total Amount"
Range("AT2").Select
ActiveCell.FormulaR1C1 = _
"=SUM(RC[-14]*RC[-31])+(RC[-13]*RC[-30])+(RC[-12]*RC[-29])"
Columns("AT:AT").Select
Selection.NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
Range("AT2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
Range("AV1").Select
ActiveCell.FormulaR1C1 = "Legal Entity"
Range("AV2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RIGHT(RC[-8],1)="")"",MID(RC[-8],LEN(RC[-8])-9,6),LEFT(RC[-8],6))"
Range("AV2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("AW1").Select
ActiveCell.FormulaR1C1 = "CCentre"
Range("AW2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RIGHT(RC[-9],1)="")"",LEFT(RC[-9],5),RIGHT(RC[-9],5))"
Range("AW2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
'// Add Additional Sheets
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Approved Timesheets"
Sheets.Add
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Approved Timesheets Pivot"
Sheets.Add
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Pending Timesheets"
Sheets.Add
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "Pending Timesheets Pivot"
Sheets.Add
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "Declined Timesheets"
Sheets.Add
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "Declined Timesheets Pivot"
Sheets.Add
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "908000 Motorola Ltd"
Sheets.Add
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "908140 - 142 Symbol Tech Ltd"
Sheets.Add
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "908400 Piping Hot Networks Ltd"
Sheets.Add
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "908500 TTPCom Ltd"
'// Copy Data to correct Sheets
Sheets("Timesheet Details").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Approved Timesheets").Select
ActiveSheet.Paste
Sheets("Pending Timesheets").Select
ActiveSheet.Paste
Sheets("Declined Timesheets").Select
ActiveSheet.Paste
Sheets("908000 Motorola Ltd").Select
ActiveSheet.Paste
Sheets("908140 - 142 Symbol Tech Ltd").Select
ActiveSheet.Paste
Sheets("908400 Piping Hot Networks Ltd").Select
ActiveSheet.Paste
Sheets("908500 TTPCom Ltd").Select
ActiveSheet.Paste
Sheets("Approved Timesheets").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("Pending Timesheets").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("Declined Timesheets").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("908000 Motorola Ltd").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("908140 - 142 Symbol Tech Ltd").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("908400 Piping Hot Networks Ltd").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("908500 TTPCom Ltd").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("Timesheet Details").Select
Range("A1").Select
'// Delete non required data from each worksheet
Sheets("Approved Timesheets").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
'Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
'Set myBaseRange = myBaseWorkSheet.Rows
'For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
' Set myBaseRow = myBaseRange.Item(RowsCounter)
' If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'
' '// Delete data that we do not need for each tab
' If myBaseRow.Cells.Item(1, 44) > StartDate Then
'
'
' myBaseRow.Delete
'
' End If
' End If
'Next
'Sheets("Pending Timesheets").Select
'
'Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
'Set myBaseRange = myBaseWorkSheet.Rows
'For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
' Set myBaseRow = myBaseRange.Item(RowsCounter)
' If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'
' '// Delete data that we do not need for each tab
' If myBaseRow.Cells.Item(1, 21) <> "Pending" Then
'
' myBaseRow.Delete
'
' End If
' End If
'Next
'
'Sheets("Declined Timesheets").Select
'
'Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
'Set myBaseRange = myBaseWorkSheet.Rows
'For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
' Set myBaseRow = myBaseRange.Item(RowsCounter)
' If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'
' '// Delete data that we do not need for each tab
' If myBaseRow.Cells.Item(1, 21) <> "Declined" Then
'
' myBaseRow.Delete
'
' End If
' End If
'Next
Sheets("908000 Motorola Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908000 Motorola Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 48) <> "908000" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908140 - 142 Symbol Tech Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908140 - 142 Symbol Tech Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 48) <> "908140" And myBaseRow.Cells.Item(1, 48) <> "908142" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908400 Piping Hot Networks Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908400 Piping Hot Networks Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 48) <> "908400" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908500 TTPCom Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908500 TTPCom Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 48) <> "908500" Then
myBaseRow.Delete
End If
End If
Next
Stop
'// Create Approved Timesheets Pivot
On Error Resume Next
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:="'Approved Timesheets'!A:AW").CreatePivotTable _
TableDestination:="'Approved Timesheets Pivot'!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
Sheets("Approved Timesheets Pivot").Select
With ActiveSheet.PivotTables("PivotTable1")
PTSubtotals .PivotFields("Legal Entity")
PTSubtotals .PivotFields("CCentre")
PTSubtotals .PivotFields("X-Ref PO ID")
PTSubtotals .PivotFields("Order ID")
PTSubtotals .PivotFields("Timesheet ID")
PTSubtotals .PivotFields("Contingent Staff First Name")
PTSubtotals .PivotFields("Contingent Staff Last Name")
PTSubtotals .PivotFields("Standard Rate")
PTSubtotals .PivotFields("Overtime Rate")
PTSubtotals .PivotFields("Second Overtime Rate")
PTSubtotals .PivotFields("Regular Hours")
PTSubtotals .PivotFields("Total Overtime Hours")
PTSubtotals .PivotFields("Total Second Overtime Hours")
PTSubtotals .PivotFields("Timesheet For Week Ending")
PTSubtotals .PivotFields("Total Amount")
PTSubtotals .PivotFields("Supplier")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Legal Entity").PivotItems _
("(blank)").Visible = False
.AddFields RowFields:=Array("Legal Entity", "CCentre", "X-Ref PO ID", "Order ID", _
"Contingent Staff First Name", "Contingent Staff Last Name", _
"Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
"Standard Rate", "Total Overtime Hours", "Overtime Rate", _
"Total Second Overtime Hours", "Second Overtime Rate", "Total Amount", "Supplier")
.PivotFields("Timesheet ID").Orientation = xlDataField
End With
With Sheets("Approved Timesheets Pivot")
With .Rows("4:4")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("E:E,F:F").ColumnWidth = 9.71
.Columns("G:G").ColumnWidth = 9.43
.Range("J:J,L:L,N:N,O:O").NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("A:A").ColumnWidth = 10.57
.Columns("B:B").ColumnWidth = 10.57
.Columns("Q:Q").Hidden = True
End With
On Error GoTo 0
''// Create Pending Timesheets Pivot
On Error Resume Next
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:="'Pending Timesheets'!A:AW").CreatePivotTable _
TableDestination:="'Pending Timesheets Pivot'!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
Sheets("Pending Timesheets Pivot").Select
With ActiveSheet.PivotTables("PivotTable1")
PTSubtotals .PivotFields("Order ID")
PTSubtotals .PivotFields("Timesheet ID")
PTSubtotals .PivotFields("X-Ref PO ID")
PTSubtotals .PivotFields("Cost Center")
PTSubtotals .PivotFields("Contingent Staff First Name")
PTSubtotals .PivotFields("Contingent Staff Last Name")
PTSubtotals .PivotFields("Standard Rate")
PTSubtotals .PivotFields("Overtime Rate")
PTSubtotals .PivotFields("Second Overtime Rate")
PTSubtotals .PivotFields("Regular Hours")
PTSubtotals .PivotFields("Total Overtime Hours")
PTSubtotals .PivotFields("Total Second Overtime Hours")
PTSubtotals .PivotFields("Timesheet For Week Ending")
PTSubtotals .PivotFields("Total Amount")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID").PivotItems _
("(blank)").Visible = False
.AddFields RowFields:=Array("Order ID", "X-Ref PO ID", "Cost Center", _
"Contingent Staff First Name", "Contingent Staff Last Name", _
"Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
"Standard Rate", "Total Overtime Hours", "Overtime Rate", _
"Total Second Overtime Hours", "Second Overtime Rate", "Total Amount")
.PivotFields("Timesheet ID").Orientation = xlDataField
End With
With Sheets("Pending Timesheets Pivot")
With .Rows("4:4")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("D:D,E:E").ColumnWidth = 9.71
.Columns("F:F").ColumnWidth = 9.43
.Range("I:I,K:K,M:M,N:N").NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("A:A").ColumnWidth = 10.57
.Columns("B:B").ColumnWidth = 10.57
.Columns("O:O").Hidden = True
End With
On Error GoTo 0
'// Create Declined Timesheets Pivot
On Error Resume Next
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:="'Declined Timesheets'!A:AW").CreatePivotTable _
TableDestination:="'Declined Timesheets Pivot'!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
Sheets("Declined Timesheets Pivot").Select
With ActiveSheet.PivotTables("PivotTable1")
PTSubtotals .PivotFields("Order ID")
PTSubtotals .PivotFields("Timesheet ID")
PTSubtotals .PivotFields("X-Ref PO ID")
PTSubtotals .PivotFields("Cost Center")
PTSubtotals .PivotFields("Contingent Staff First Name")
PTSubtotals .PivotFields("Contingent Staff Last Name")
PTSubtotals .PivotFields("Standard Rate")
PTSubtotals .PivotFields("Overtime Rate")
PTSubtotals .PivotFields("Second Overtime Rate")
PTSubtotals .PivotFields("Regular Hours")
PTSubtotals .PivotFields("Total Overtime Hours")
PTSubtotals .PivotFields("Total Second Overtime Hours")
PTSubtotals .PivotFields("Timesheet For Week Ending")
PTSubtotals .PivotFields("Total Amount")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID").PivotItems _
("(blank)").Visible = False
.AddFields RowFields:=Array("Order ID", "X-Ref PO ID", "Cost Center", _
"Contingent Staff First Name", "Contingent Staff Last Name", _
"Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
"Standard Rate", "Total Overtime Hours", "Overtime Rate", _
"Total Second Overtime Hours", "Second Overtime Rate", "Total Amount")
.PivotFields("Timesheet ID").Orientation = xlDataField
End With
With Sheets("Declined Timesheets Pivot")
With .Rows("4:4")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("D:D,E:E").ColumnWidth = 9.71
.Columns("F:F").ColumnWidth = 9.43
.Range("I:I,K:K,M:M,N:N").NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("A:A").ColumnWidth = 10.57
.Columns("B:B").ColumnWidth = 10.57
.Columns("O:O").Hidden = True
End With
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
What I would like to be able to do is:
1) For each Legal Entity (Column AV) create a worksheet containing the approved (column AR, if contains date then = approved, alternatively status column = Approved) data for that legal entity, name the sheet as legal entity. And create a pivot table of the same data on anotherr worksheet named Legal Entity - Pivot. The Legal Entity data is extracted as part of the code above.
2) For each Supplier A,B,C create a worksheet containing the approved (column AR, if contains date then = approved, alternatively status column = Approved) data for that supplier, name the sheet as supplier. And create a pivot table of the same data on anotherr worksheet named supplier name - Pivot
3)Create a worksheet containing only Pending Timesheets (Status column)
4)Create a worksheet containing only Declined Timesheets (Status column)
I hope this makes sense.
Thanks in advance
Marshybid
~Corrupt Attachment Removed. Please repost with valid file.
xld, this is the complete macro as previously discussed.
I have a report that I run weekly and I need to perform a number of filters and create a number of worksheets and pivots.
Currently this is very slow and also does not do all that I need. I have attached an example spreadsheet.
Private Function PTSubtotals(ByRef PTField As PivotField)
PTField.Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
End Function
Sub Timesheets()
'
' Timesheets Macro
' Timesheet Filter 4/22/2008 by Richard Francis
'
Dim myWorkBook As Workbook
Dim myBaseWorkSheet As Worksheet
Dim myBaseRange As Range
Dim myBaseRow As Range
Dim RowsCounter As Long
'Dim StartDate As Date
'
'On Error Resume Next
' StartDate = Application.InputBox("Enter start date", Type:=2)
' On Error GoTo 0
' If StartDate > 0 Then
'
' Else
'
' End If
Application.ScreenUpdating = False
'// Add required columns and formulas
ActiveSheet.Name = "Timesheet Details"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Order ID"
Range("A1:AR1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.Bold = True
Selection.AutoFilter
Range("A1").Select
Columns("Y:Y").Select
Selection.Insert Shift:=xlToRight
Range("Y1").Select
ActiveCell.FormulaR1C1 = "Timesheet For Week Ending"
Range("Y2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1))"
Range("Y2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
Columns("AS:AS").Select
Selection.Insert Shift:=xlToRight
Range("AS1").Select
ActiveCell.FormulaR1C1 = "Approved in Week Ending"
Range("AS2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1))"
Range("AS2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
Columns("AT:AT").Select
Selection.Insert Shift:=xlToRight
Range("AT1").Select
ActiveCell.FormulaR1C1 = "Total Amount"
Range("AT2").Select
ActiveCell.FormulaR1C1 = _
"=SUM(RC[-14]*RC[-31])+(RC[-13]*RC[-30])+(RC[-12]*RC[-29])"
Columns("AT:AT").Select
Selection.NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
Range("AT2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
Range("AV1").Select
ActiveCell.FormulaR1C1 = "Legal Entity"
Range("AV2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RIGHT(RC[-8],1)="")"",MID(RC[-8],LEN(RC[-8])-9,6),LEFT(RC[-8],6))"
Range("AV2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("AW1").Select
ActiveCell.FormulaR1C1 = "CCentre"
Range("AW2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RIGHT(RC[-9],1)="")"",LEFT(RC[-9],5),RIGHT(RC[-9],5))"
Range("AW2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
'// Add Additional Sheets
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Approved Timesheets"
Sheets.Add
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Approved Timesheets Pivot"
Sheets.Add
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Pending Timesheets"
Sheets.Add
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "Pending Timesheets Pivot"
Sheets.Add
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "Declined Timesheets"
Sheets.Add
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "Declined Timesheets Pivot"
Sheets.Add
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "908000 Motorola Ltd"
Sheets.Add
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "908140 - 142 Symbol Tech Ltd"
Sheets.Add
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "908400 Piping Hot Networks Ltd"
Sheets.Add
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "908500 TTPCom Ltd"
'// Copy Data to correct Sheets
Sheets("Timesheet Details").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Approved Timesheets").Select
ActiveSheet.Paste
Sheets("Pending Timesheets").Select
ActiveSheet.Paste
Sheets("Declined Timesheets").Select
ActiveSheet.Paste
Sheets("908000 Motorola Ltd").Select
ActiveSheet.Paste
Sheets("908140 - 142 Symbol Tech Ltd").Select
ActiveSheet.Paste
Sheets("908400 Piping Hot Networks Ltd").Select
ActiveSheet.Paste
Sheets("908500 TTPCom Ltd").Select
ActiveSheet.Paste
Sheets("Approved Timesheets").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("Pending Timesheets").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("Declined Timesheets").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("908000 Motorola Ltd").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("908140 - 142 Symbol Tech Ltd").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("908400 Piping Hot Networks Ltd").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("908500 TTPCom Ltd").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("Timesheet Details").Select
Range("A1").Select
'// Delete non required data from each worksheet
Sheets("Approved Timesheets").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
'Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
'Set myBaseRange = myBaseWorkSheet.Rows
'For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
' Set myBaseRow = myBaseRange.Item(RowsCounter)
' If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'
' '// Delete data that we do not need for each tab
' If myBaseRow.Cells.Item(1, 44) > StartDate Then
'
'
' myBaseRow.Delete
'
' End If
' End If
'Next
'Sheets("Pending Timesheets").Select
'
'Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
'Set myBaseRange = myBaseWorkSheet.Rows
'For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
' Set myBaseRow = myBaseRange.Item(RowsCounter)
' If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'
' '// Delete data that we do not need for each tab
' If myBaseRow.Cells.Item(1, 21) <> "Pending" Then
'
' myBaseRow.Delete
'
' End If
' End If
'Next
'
'Sheets("Declined Timesheets").Select
'
'Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
'Set myBaseRange = myBaseWorkSheet.Rows
'For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
' Set myBaseRow = myBaseRange.Item(RowsCounter)
' If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'
' '// Delete data that we do not need for each tab
' If myBaseRow.Cells.Item(1, 21) <> "Declined" Then
'
' myBaseRow.Delete
'
' End If
' End If
'Next
Sheets("908000 Motorola Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908000 Motorola Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 48) <> "908000" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908140 - 142 Symbol Tech Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908140 - 142 Symbol Tech Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 48) <> "908140" And myBaseRow.Cells.Item(1, 48) <> "908142" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908400 Piping Hot Networks Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908400 Piping Hot Networks Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 48) <> "908400" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908500 TTPCom Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
myBaseRow.Delete
End If
End If
Next
Sheets("908500 TTPCom Ltd").Select
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 48) <> "908500" Then
myBaseRow.Delete
End If
End If
Next
Stop
'// Create Approved Timesheets Pivot
On Error Resume Next
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:="'Approved Timesheets'!A:AW").CreatePivotTable _
TableDestination:="'Approved Timesheets Pivot'!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
Sheets("Approved Timesheets Pivot").Select
With ActiveSheet.PivotTables("PivotTable1")
PTSubtotals .PivotFields("Legal Entity")
PTSubtotals .PivotFields("CCentre")
PTSubtotals .PivotFields("X-Ref PO ID")
PTSubtotals .PivotFields("Order ID")
PTSubtotals .PivotFields("Timesheet ID")
PTSubtotals .PivotFields("Contingent Staff First Name")
PTSubtotals .PivotFields("Contingent Staff Last Name")
PTSubtotals .PivotFields("Standard Rate")
PTSubtotals .PivotFields("Overtime Rate")
PTSubtotals .PivotFields("Second Overtime Rate")
PTSubtotals .PivotFields("Regular Hours")
PTSubtotals .PivotFields("Total Overtime Hours")
PTSubtotals .PivotFields("Total Second Overtime Hours")
PTSubtotals .PivotFields("Timesheet For Week Ending")
PTSubtotals .PivotFields("Total Amount")
PTSubtotals .PivotFields("Supplier")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Legal Entity").PivotItems _
("(blank)").Visible = False
.AddFields RowFields:=Array("Legal Entity", "CCentre", "X-Ref PO ID", "Order ID", _
"Contingent Staff First Name", "Contingent Staff Last Name", _
"Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
"Standard Rate", "Total Overtime Hours", "Overtime Rate", _
"Total Second Overtime Hours", "Second Overtime Rate", "Total Amount", "Supplier")
.PivotFields("Timesheet ID").Orientation = xlDataField
End With
With Sheets("Approved Timesheets Pivot")
With .Rows("4:4")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("E:E,F:F").ColumnWidth = 9.71
.Columns("G:G").ColumnWidth = 9.43
.Range("J:J,L:L,N:N,O:O").NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("A:A").ColumnWidth = 10.57
.Columns("B:B").ColumnWidth = 10.57
.Columns("Q:Q").Hidden = True
End With
On Error GoTo 0
''// Create Pending Timesheets Pivot
On Error Resume Next
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:="'Pending Timesheets'!A:AW").CreatePivotTable _
TableDestination:="'Pending Timesheets Pivot'!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
Sheets("Pending Timesheets Pivot").Select
With ActiveSheet.PivotTables("PivotTable1")
PTSubtotals .PivotFields("Order ID")
PTSubtotals .PivotFields("Timesheet ID")
PTSubtotals .PivotFields("X-Ref PO ID")
PTSubtotals .PivotFields("Cost Center")
PTSubtotals .PivotFields("Contingent Staff First Name")
PTSubtotals .PivotFields("Contingent Staff Last Name")
PTSubtotals .PivotFields("Standard Rate")
PTSubtotals .PivotFields("Overtime Rate")
PTSubtotals .PivotFields("Second Overtime Rate")
PTSubtotals .PivotFields("Regular Hours")
PTSubtotals .PivotFields("Total Overtime Hours")
PTSubtotals .PivotFields("Total Second Overtime Hours")
PTSubtotals .PivotFields("Timesheet For Week Ending")
PTSubtotals .PivotFields("Total Amount")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID").PivotItems _
("(blank)").Visible = False
.AddFields RowFields:=Array("Order ID", "X-Ref PO ID", "Cost Center", _
"Contingent Staff First Name", "Contingent Staff Last Name", _
"Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
"Standard Rate", "Total Overtime Hours", "Overtime Rate", _
"Total Second Overtime Hours", "Second Overtime Rate", "Total Amount")
.PivotFields("Timesheet ID").Orientation = xlDataField
End With
With Sheets("Pending Timesheets Pivot")
With .Rows("4:4")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("D:D,E:E").ColumnWidth = 9.71
.Columns("F:F").ColumnWidth = 9.43
.Range("I:I,K:K,M:M,N:N").NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("A:A").ColumnWidth = 10.57
.Columns("B:B").ColumnWidth = 10.57
.Columns("O:O").Hidden = True
End With
On Error GoTo 0
'// Create Declined Timesheets Pivot
On Error Resume Next
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:="'Declined Timesheets'!A:AW").CreatePivotTable _
TableDestination:="'Declined Timesheets Pivot'!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
Sheets("Declined Timesheets Pivot").Select
With ActiveSheet.PivotTables("PivotTable1")
PTSubtotals .PivotFields("Order ID")
PTSubtotals .PivotFields("Timesheet ID")
PTSubtotals .PivotFields("X-Ref PO ID")
PTSubtotals .PivotFields("Cost Center")
PTSubtotals .PivotFields("Contingent Staff First Name")
PTSubtotals .PivotFields("Contingent Staff Last Name")
PTSubtotals .PivotFields("Standard Rate")
PTSubtotals .PivotFields("Overtime Rate")
PTSubtotals .PivotFields("Second Overtime Rate")
PTSubtotals .PivotFields("Regular Hours")
PTSubtotals .PivotFields("Total Overtime Hours")
PTSubtotals .PivotFields("Total Second Overtime Hours")
PTSubtotals .PivotFields("Timesheet For Week Ending")
PTSubtotals .PivotFields("Total Amount")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID").PivotItems _
("(blank)").Visible = False
.AddFields RowFields:=Array("Order ID", "X-Ref PO ID", "Cost Center", _
"Contingent Staff First Name", "Contingent Staff Last Name", _
"Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
"Standard Rate", "Total Overtime Hours", "Overtime Rate", _
"Total Second Overtime Hours", "Second Overtime Rate", "Total Amount")
.PivotFields("Timesheet ID").Orientation = xlDataField
End With
With Sheets("Declined Timesheets Pivot")
With .Rows("4:4")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("D:D,E:E").ColumnWidth = 9.71
.Columns("F:F").ColumnWidth = 9.43
.Range("I:I,K:K,M:M,N:N").NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("A:A").ColumnWidth = 10.57
.Columns("B:B").ColumnWidth = 10.57
.Columns("O:O").Hidden = True
End With
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
What I would like to be able to do is:
1) For each Legal Entity (Column AV) create a worksheet containing the approved (column AR, if contains date then = approved, alternatively status column = Approved) data for that legal entity, name the sheet as legal entity. And create a pivot table of the same data on anotherr worksheet named Legal Entity - Pivot. The Legal Entity data is extracted as part of the code above.
2) For each Supplier A,B,C create a worksheet containing the approved (column AR, if contains date then = approved, alternatively status column = Approved) data for that supplier, name the sheet as supplier. And create a pivot table of the same data on anotherr worksheet named supplier name - Pivot
3)Create a worksheet containing only Pending Timesheets (Status column)
4)Create a worksheet containing only Declined Timesheets (Status column)
I hope this makes sense.
Thanks in advance
Marshybid
~Corrupt Attachment Removed. Please repost with valid file.