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