PDA

View Full Version : Solved: Macro is really slow



marshybid
04-28-2008, 03:25 AM
Hi All,

Thanks to xld especially for his input in helping me with parts if this macro (see below)



Dim myWorkBook As Workbook
Dim myBaseWorkSheet As Worksheet
Dim myBaseRange As Range
Dim myBaseRow As Range
Dim RowsCounter As Long
Dim StartDate As Date
Dim EndDate As Date
On Error Resume Next
StartDate = Application.InputBox("Enter start date", Type:=2)
On Error GoTo 0
If StartDate > 0 Then

On Error Resume Next
EndDate = Application.InputBox("Enter end date", Type:=2)
On Error GoTo 0
If EndDate > 0 Then

If EndDate < StartDate Then

MsgBox "Start date can not be earlier than end date"
Else

End If
End If
End If

'// Add required columns and formulas
Sheets("Timesheet Details").Select
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 = "=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 = "=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("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"


'// 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("Approved Timesheets").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Pending Timesheets").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("Declined Timesheets").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, 1)) <> 0 Then

'// Delete data that we do not need for each tab
If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
If myBaseRow.Cells.Item(1, 44) >= StartDate And myBaseRow.Cells.Item(1, 44) <= EndDate Then

myBaseRow.Delete

End If
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, 1)) <> 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, 1)) <> 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


Following the above code I then create a pivot table for each type of data based upon seperate criteria.

2 things;

1) All I really want to do is select each type of data (Approved, Pending and Declined - Cells.Item(1, 21) - ) from the source data and only copy those rows to the appropriate sheets (at present I just copy all data to each sheet then filter each sheet seperately) this process takes c. 5 - 7 minutes :help

2) Even though I have added the inputbox data (thanks xld) it does not appear to be filtering by the start and end date (for Approved Timesheets only)

Any help. much appreciated.

Thanks, Marshybid

xld
04-28-2008, 03:49 AM
You need to post a workbook, that is beytond the cause trying to work that lot through.

marshybid
04-28-2008, 04:00 AM
Example worksheet attached.

Hope this helps :think:

xld
04-28-2008, 04:20 AM
There is no code in that workbook example.

marshybid
04-28-2008, 04:34 AM
Apologies, I thought you could run the macro that I pasted in my original query. The attachment is the raw data.

Could you let me know what it is that you need please.

Thanks

xld
04-28-2008, 05:09 AM
Why are you bothering with all of this, why not just Pivot Timesheet Details. You can select the status, and/or the date range.

marshybid
04-28-2008, 05:14 AM
Hi xld, I am seperating them out individually as they are each presented as a seperate report to a different recipient list, the pivot table shows a quick view with the backup data available as a reference as and when required.

I thought the best way would be to create a worksheet for each type of data then pivot each of those individually.

maybe I'm going about it the wrong way!!

xld
04-28-2008, 05:51 AM
You can do it that way, it just seems to me you could do it all with one pivot.

xld
04-28-2008, 06:16 AM
This should be a bit (much!) quicker, and also outsort correctly




Sub marshybid()
Dim myWorkBook As Workbook
Dim myBaseWorkSheet As Worksheet
Dim myBaseRange As Range
Dim myBaseRow As Range
Dim RowsCounter As Long
Dim StartDate As Date
Dim EndDate As Date
Dim LastRow As Long

On Error Resume Next
StartDate = Application.InputBox("Enter start date", Type:=2)
On Error GoTo 0
If StartDate > 0 Then

On Error Resume Next
EndDate = Application.InputBox("Enter end date", Type:=2)
On Error GoTo 0
If EndDate > 0 Then

If EndDate < StartDate Then

MsgBox "Start date can not be earlier than end date"
Else

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Approved Timesheets").Delete
Worksheets("Approved Timesheets Pivot").Delete
Worksheets("Pending Timesheets").Delete
Worksheets("Pending Timesheets Pivot").Delete
Worksheets("Declined Timesheets").Delete
Worksheets("Declined Timesheets Pivot").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'// Add Additional Sheets
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Approved Timesheets"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Approved Timesheets Pivot"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Pending Timesheets"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Pending Timesheets Pivot"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Declined Timesheets"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Declined Timesheets Pivot"

'// Add required columns and formulas
With Sheets("Timesheet Details")

LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row

.Range("B1").Value = "Order ID"
With .Range("A1:AR1")

.Interior.ColorIndex = 6
.Font.Bold = True
.AutoFilter
End With
.Columns("AT:AT").Insert Shift:=xlToRight
.Range("AT1").Value = "Approved in W/e"
.Range("AT2").Resize(LastRow - 1).FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"
.Columns("AT:AT").Insert Shift:=xlToRight
.Range("AT1").Value = "Total Amount"
.Range("AT2").Resize(LastRow - 1).FormulaR1C1 = _
"=SUM(RC[-14]*RC[-31])+(RC[-13]*RC[-30])+(RC[-12]*RC[-29])"
.Range("AT2").Resize(LastRow - 1).NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("Y:Y").Insert Shift:=xlToRight
.Range("Y1").Value = "Timesheet For W/e"
.Range("Y2").Resize(LastRow - 1).FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"

'// Copy Data to correct Sheets

Set myBaseRange = .Rows("1:" & LastRow)

myBaseRange.AutoFilter Field:=21, Criteria1:="Approved"
myBaseRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Approved Timesheets").Cells
Worksheets("Approved Timesheets").Rows("1:1").AutoFilter

myBaseRange.AutoFilter Field:=21, Criteria1:="Pending"
myBaseRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Pending Timesheets").Cells
Worksheets("Pending Timesheets").Rows("1:1").AutoFilter

myBaseRange.AutoFilter Field:=21, Criteria1:="Declined"
myBaseRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Declined Timesheets").Cells
Worksheets("Declined Timesheets").Rows("1:1").AutoFilter
End With

'// Delete non required data from each worksheet
With Sheets("Approved Timesheets")

LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Columns("X:X").Insert Shift:=xlToRight
.Range("X2").Resize(LastRow - 1).Formula = "=AND(V2>=" & CLng(StartDate) & _
",W2<=" & CLng(EndDate) & ")"

Set myBaseRange = .Rows("1:" & LastRow)
myBaseRange.AutoFilter Field:=24, _
Criteria1:="=FALSE"
On Error Resume Next
Set myBaseRange = .Range("V2").Resize(LastRow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myBaseRange Is Nothing Then

myBaseRange.EntireRow.Delete
End If
.Columns("X:X").Delete
End With

With Sheets("Pending Timesheets")

LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Columns("X:X").Insert Shift:=xlToRight
.Range("X2").Resize(LastRow - 1).Formula = "=AND(V2>=" & CLng(StartDate) & _
",W2<=" & CLng(EndDate) & ")"

Set myBaseRange = .Rows("1:" & LastRow)
myBaseRange.AutoFilter Field:=24, _
Criteria1:="=FALSE"
On Error Resume Next
Set myBaseRange = .Range("V2").Resize(LastRow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myBaseRange Is Nothing Then

myBaseRange.EntireRow.Delete
End If
.Columns("X:X").Delete
End With

With Sheets("Declined Timesheets")

LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Columns("X:X").Insert Shift:=xlToRight
.Range("X2").Resize(LastRow - 1).Formula = "=AND(V2>=" & CLng(StartDate) & _
",W2<=" & CLng(EndDate) & ")"

Set myBaseRange = .Rows("1:" & LastRow)
myBaseRange.AutoFilter Field:=24, _
Criteria1:="=FALSE"
On Error Resume Next
Set myBaseRange = .Range("V2").Resize(LastRow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myBaseRange Is Nothing Then

myBaseRange.EntireRow.Delete
End If
.Columns("X:X").Delete
End With
End If
End If

Application.ScreenUpdating = True
End Sub

marshybid
04-28-2008, 07:24 AM
Thanks xld. That is definitely a lot quicker.

Now I have seen how you did it I will be able to adapt this to a number of other macros that I need to run.

Your time and patience is greatly appreciated.

Marshybid :bow:

marshybid
04-28-2008, 02:31 PM
Hi xld,

As per request, here is the full code that I am now using. I had toi cajnge a couple of the cell references as they were pointing to the wrong place in the original.



Sub TSheetv2()

Dim myWorkBook As Workbook
Dim myBaseWorkSheet As Worksheet
Dim myBaseRange As Range
Dim myBaseRow As Range
Dim RowsCounter As Long
Dim StartDate As Date
Dim EndDate As Date
Dim LastRow As Long

On Error Resume Next
StartDate = Application.InputBox("Enter start date", Type:=2)
On Error GoTo 0
If StartDate > 0 Then

On Error Resume Next
EndDate = Application.InputBox("Enter end date", Type:=2)
On Error GoTo 0
If EndDate > 0 Then

If EndDate < StartDate Then

MsgBox "Start date can not be earlier than end date"
Else

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Approved Timesheets").Delete
Worksheets("Approved Timesheets Pivot").Delete
Worksheets("Pending Timesheets").Delete
Worksheets("Pending Timesheets Pivot").Delete
Worksheets("Declined Timesheets").Delete
Worksheets("Declined Timesheets Pivot").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'// Add Additional Sheets
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Approved Timesheets"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Approved Timesheets Pivot"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Pending Timesheets"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Pending Timesheets Pivot"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Declined Timesheets"
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Declined Timesheets Pivot"

'// Add required columns and formulas
With Sheets("Timesheet Details")

LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row

.Range("B1").Value = "Order ID"
With .Range("A1:AR1")

.Interior.ColorIndex = 6
.Font.Bold = True
.AutoFilter
End With
.Columns("AR:AR").Insert Shift:=xlToRight
.Range("AR1").Value = "Approved in W/e"
.Range("AR2").Resize(LastRow - 1).FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"
.Columns("AS:AS").Insert Shift:=xlToRight
.Range("AS1").Value = "Total Amount"
.Range("AS2").Resize(LastRow - 1).FormulaR1C1 = _
"=SUM(RC[-14]*RC[-31])+(RC[-13]*RC[-30])+(RC[-12]*RC[-29])"
.Range("AS2").Resize(LastRow - 1).NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("Y:Y").Insert Shift:=xlToRight
.Range("Y1").Value = "Timesheet For W/e"
.Range("Y2").Resize(LastRow - 1).FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"

'// Copy Data to correct Sheets

Set myBaseRange = .Rows("1:" & LastRow)

myBaseRange.AutoFilter Field:=21, Criteria1:="Approved"
myBaseRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Approved Timesheets").Cells
Worksheets("Approved Timesheets").Rows("1:1").AutoFilter

myBaseRange.AutoFilter Field:=21, Criteria1:="Pending"
myBaseRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Pending Timesheets").Cells
Worksheets("Pending Timesheets").Rows("1:1").AutoFilter

myBaseRange.AutoFilter Field:=21, Criteria1:="Declined"
myBaseRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Declined Timesheets").Cells
Worksheets("Declined Timesheets").Rows("1:1").AutoFilter
End With

'// Delete non required data from each worksheet
With Sheets("Approved Timesheets")

LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Columns("X:X").Insert Shift:=xlToRight
.Range("X2").Resize(LastRow - 1).Formula = "=AND(V2>=" & CLng(StartDate) & _
",W2<=" & CLng(EndDate) & ")"

Set myBaseRange = .Rows("1:" & LastRow)
myBaseRange.AutoFilter Field:=24, _
Criteria1:="=FALSE"
On Error Resume Next
Set myBaseRange = .Range("V2").Resize(LastRow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myBaseRange Is Nothing Then

myBaseRange.EntireRow.Delete
End If
.Columns("X:X").Delete
End With

With Sheets("Pending Timesheets")

LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Columns("X:X").Insert Shift:=xlToRight
.Range("X2").Resize(LastRow - 1).Formula = "=AND(V2>=" & CLng(StartDate) & _
",W2<=" & CLng(EndDate) & ")"

Set myBaseRange = .Rows("1:" & LastRow)
myBaseRange.AutoFilter Field:=24, _
Criteria1:="=FALSE"
On Error Resume Next
Set myBaseRange = .Range("V2").Resize(LastRow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myBaseRange Is Nothing Then

myBaseRange.EntireRow.Delete
End If
.Columns("X:X").Delete
End With

With Sheets("Declined Timesheets")

LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Columns("X:X").Insert Shift:=xlToRight
.Range("X2").Resize(LastRow - 1).Formula = "=AND(V2>=" & CLng(StartDate) & _
",W2<=" & CLng(EndDate) & ")"

Set myBaseRange = .Rows("1:" & LastRow)
myBaseRange.AutoFilter Field:=24, _
Criteria1:="=FALSE"
On Error Resume Next
Set myBaseRange = .Range("V2").Resize(LastRow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myBaseRange Is Nothing Then

myBaseRange.EntireRow.Delete
End If
.Columns("X:X").Delete
End With
End If
End If

'// Create Approved Timesheets Pivot
Sheets("Approved Timesheets").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"'Approved Timesheets'!A:AU").CreatePivotTable _
TableDestination:="'Approved Timesheets Pivot'!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion10
Sheets("Approved Timesheets Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID")
.Subtotals = Array(False, False, False, False, False, False, False, False, False, _
False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Timesheet ID").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("X-Ref PO ID").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("User ID").Subtotals = Array _
(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Contingent Staff First Name").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Contingent Staff Last Name" _
).Subtotals = Array(False, False, False, False, False, False, False, False, False, False _
, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Standard Rate").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Overtime Rate").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Second Overtime Rate"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Regular Hours").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Total Overtime Hours"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Total Second Overtime Hours").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Timesheet For W/e").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Date Approved").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Total Amount").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:=Array("Order ID", _
"X-Ref PO ID", "User ID", "Contingent Staff First Name", _
"Contingent Staff Last Name", "Timesheet ID", "Timesheet For W/e", "Date Approved", "Regular Hours", "Standard Rate", _
"Total Overtime Hours", "Overtime Rate", "Total Second Overtime Hours", _
"Second Overtime Rate", "Total Amount")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Timesheet ID").Orientation _
= xlDataField
End With
Sheets("Approved Timesheets Pivot").Select
Rows("4:4").Select
With Selection
.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").Select
Range("E1").Activate
Selection.ColumnWidth = 9.71
Columns("F:F").ColumnWidth = 9.43
Range("H:H,J:J,L:L,M:M").Select
Range("M1").Activate
Selection.NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
Range("A1").Select
Columns("A:A").ColumnWidth = 10.57
Columns("B:B").ColumnWidth = 10.57
Columns("N:N").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select

'// Create Pending Timesheets Pivot

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"'Pending Timesheets'!A:AU").CreatePivotTable _
TableDestination:="'Pending Timesheets Pivot'!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion10
Sheets("Pending Timesheets Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID")
.Subtotals = Array(False, False, False, False, False, False, False, False, False, _
False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Timesheet ID").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("X-Ref PO ID").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("User ID").Subtotals = Array _
(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Contingent Staff First Name").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Contingent Staff Last Name" _
).Subtotals = Array(False, False, False, False, False, False, False, False, False, False _
, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Standard Rate").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Overtime Rate").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Second Overtime Rate"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Regular Hours").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Total Overtime Hours"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Total Second Overtime Hours").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Timesheet For W/e").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Date Approved").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Total Amount").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:=Array("Order ID", _
"X-Ref PO ID", "User ID", "Contingent Staff First Name", _
"Contingent Staff Last Name", "Timesheet ID", "Timesheet For W/e", "Date Approved", "Regular Hours", "Standard Rate", _
"Total Overtime Hours", "Overtime Rate", "Total Second Overtime Hours", _
"Second Overtime Rate", "Total Amount")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Timesheet ID").Orientation _
= xlDataField
End With
Sheets("Pending Timesheets Pivot").Select
Rows("4:4").Select
With Selection
.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").Select
Range("E1").Activate
Selection.ColumnWidth = 9.71
Columns("F:F").ColumnWidth = 9.43
Range("H:H,J:J,L:L,M:M").Select
Range("M1").Activate
Selection.NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
Range("A1").Select
Columns("A:A").ColumnWidth = 10.57
Columns("B:B").ColumnWidth = 10.57
Columns("N:N").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select

'// Create Declined Timesheets Pivot

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"'Declined Timesheets'!A:AU").CreatePivotTable _
TableDestination:="'Declined Timesheets Pivot'!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion10
Sheets("Declined Timesheets Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID")
.Subtotals = Array(False, False, False, False, False, False, False, False, False, _
False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Timesheet ID").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("X-Ref PO ID").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("User ID").Subtotals = Array _
(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Contingent Staff First Name").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Contingent Staff Last Name" _
).Subtotals = Array(False, False, False, False, False, False, False, False, False, False _
, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Standard Rate").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Overtime Rate").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Second Overtime Rate"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Regular Hours").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Total Overtime Hours"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Total Second Overtime Hours").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Timesheet For W/e").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Date Approved").Subtotals = Array(False, False, False, False, False, _
False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Total Amount").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:=Array("Order ID", _
"X-Ref PO ID", "User ID", "Contingent Staff First Name", _
"Contingent Staff Last Name", "Timesheet ID", "Timesheet For W/e", "Date Approved", "Regular Hours", "Standard Rate", _
"Total Overtime Hours", "Overtime Rate", "Total Second Overtime Hours", _
"Second Overtime Rate", "Total Amount")
ActiveSheet.PivotTables("PivotTable1").PivotFields("Timesheet ID").Orientation _
= xlDataField
End With
Sheets("Declined Timesheets Pivot").Select
Rows("4:4").Select
With Selection
.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").Select
Range("E1").Activate
Selection.ColumnWidth = 9.71
Columns("F:F").ColumnWidth = 9.43
Range("H:H,J:J,L:L,M:M").Select
Range("M1").Activate
Selection.NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
Range("A1").Select
Columns("A:A").ColumnWidth = 10.57
Columns("B:B").ColumnWidth = 10.57
Columns("N:N").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select

Application.ScreenUpdating = True
End Sub


Issues are:

1) Approved Timesheets worksheet has no header row as part of copy

2) Approved Timesheet worksheet just contains all approved timesheets and doesn't filter by approved date (column AQ in original data) This is the date that should be >=Start date <=End Date as per input box

You can use the previous attachment Example.zip as the base data

Thanks a lot,

Marshybid :bow:

xld
04-28-2008, 02:36 PM
What cell references did you change?

What dates did you input?

marshybid
04-28-2008, 02:43 PM
Original code you provided -



.Columns("AT:AT").Insert Shift:=xlToRight
.Range("AT1").Value = "Approved in W/e"
.Range("AT2").Resize(LastRow - 1).FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"
.Columns("AT:AT").Insert Shift:=xlToRight
.Range("AT1").Value = "Total Amount"
.Range("AT2").Resize(LastRow - 1).FormulaR1C1 = _
"=SUM(RC[-14]*RC[-31])+(RC[-13]*RC[-30])+(RC[-12]*RC[-29])"
.Range("AT2").Resize(LastRow - 1).NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("Y:Y").Insert Shift:=xlToRight
.Range("Y1").Value = "Timesheet For W/e"
.Range("Y2").Resize(LastRow - 1).FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)


mine -



.Columns("AR:AR").Insert Shift:=xlToRight
.Range("AR1").Value = "Approved in W/e"
.Range("AR2").Resize(LastRow - 1).FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"
.Columns("AS:AS").Insert Shift:=xlToRight
.Range("AS1").Value = "Total Amount"
.Range("AS2").Resize(LastRow - 1).FormulaR1C1 = _
"=SUM(RC[-14]*RC[-31])+(RC[-13]*RC[-30])+(RC[-12]*RC[-29])"
.Range("AS2").Resize(LastRow - 1).NumberFormat = _
"_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
.Columns("Y:Y").Insert Shift:=xlToRight
.Range("Y1").Value = "Timesheet For W/e"
.Range("Y2").Resize(LastRow - 1).FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"


Also, removed delete data for Pending and Declined Timesheets as these will never have an approved date to filter by.

xld
04-28-2008, 02:56 PM
I think that all you need to do is to update the formula thattests the date range, that is change tis



.Range("X2").Resize(LastRow - 1).Formula = "=AND(V2>=" & CLng(StartDate) & _
",W2<=" & CLng(EndDate) & ")"


to



.Range("X2").Resize(LastRow - 1).Formula = "=AND(AR2>=" & CLng(StartDate) & _
",AR2<=" & CLng(EndDate) & ")"


for all 3 timesheet types.

I see you have aded PT creation, but you still do all that nasty selecting!

xld
04-28-2008, 03:00 PM
Also, removed delete data for Pending and Declined Timesheets as these will never have an approved date to filter by.

This still looks there to me. What did you remove?

marshybid
04-28-2008, 03:30 PM
Thanks xld. I'll try that.

I'm very new to VB and pivot tables are particularly tricky for me. If you can suggest an easier way of coding them I'd be very happy to try to understand it.

Thanks,

And catch up tomorrow re: Missing Timesheet table.

:beerchug: