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

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

**Bob Phillips** · 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

**Bob Phillips** · 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

**Bob Phillips** · 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!!

**Bob Phillips** · 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.

**Bob Phillips** · 04-28-2008, 06:16 AM

This should be a bit (much!) quicker, and also outsort correctly

[vba]

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
[/vba]

**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

**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

**Bob Phillips** · 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.

**Bob Phillips** · 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

[vba]

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

to

[vba]

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

for all 3 timesheet types.

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

**Bob Phillips** · 04-28-2008, 03:00 PM

Originally Posted by marshybid

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.

Thread: Solved: Macro is really slow

Thread Tools

Display

Solved: Macro is really slow

Posting Permissions