bubbapost
07-30-2010, 07:00 AM
Hello,
I have a Time Off Reviewer workbook that is basically UI with a workbook with all the data on the backend. I starting out using the For/Next loop, but as the data grew, it kept getting slower and slower. Can someone help me speed up this code with AutoFilter?
I also posted @ MrExcel MsgBrd http://www.mrexcel.com/forum/showthread.php?t=484920
Here is my code:
Sub Approved()
Set WBR = ActiveWorkbook
Set WSD = WBR.Worksheets("Data")
Set WSR = WBR.Worksheets("Request Review")
Set CurRec = WSR.Range("CurrRec")
Set Cmt = WSR.Range("Comment")
Set LastRec = WSR.Range("TotalRec")
iRow = CurRec.Value
Application.ScreenUpdating = False
If WSR.Range("G6") <> "Submitted" Then
MsgBox "This request has already been reviewed & responded to."
Exit Sub
End If
Set WBD = Workbooks.Open(Filename:="G:\U\Dashboard\Time Off\Master\TOATData.xlsx")
Set WSData = WBD.Worksheets("Data") 'Data worksheet
'On Error GoTo 0
'Select the Data worksheet
WSData.Select
WSData.AutoFilter.ShowAllData
WSData.Select
FinalRow = WSData.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To FinalRow
If Cells(i, 1) = iRow Then
Cells(i, 14) = "Approved"
Cells(i, 15) = Cmt.Value
Cells(i, 16) = Now()
End If
Next i
WBD.Save
WSData.Cells.Copy
WBR.Activate
WSD.Select
Cells(1, 1).Select
Selection.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
WBD.Close True
WSD.Activate
WSD.Columns.AutoFit
WSD.Columns("M:M").ColumnWidth = 50
WSD.Range("A1").AutoFilter
WSD.Range("C2").Select
ActiveWindow.FreezePanes = True
WSR.Select
Cmt.Value = ""
Call StatusEmail
If CurRec < LastRec Then
CurRec = CurRec + 1
End If
Application.ScreenUpdating = True
End Sub
Thank you in advance!
I have a Time Off Reviewer workbook that is basically UI with a workbook with all the data on the backend. I starting out using the For/Next loop, but as the data grew, it kept getting slower and slower. Can someone help me speed up this code with AutoFilter?
I also posted @ MrExcel MsgBrd http://www.mrexcel.com/forum/showthread.php?t=484920
Here is my code:
Sub Approved()
Set WBR = ActiveWorkbook
Set WSD = WBR.Worksheets("Data")
Set WSR = WBR.Worksheets("Request Review")
Set CurRec = WSR.Range("CurrRec")
Set Cmt = WSR.Range("Comment")
Set LastRec = WSR.Range("TotalRec")
iRow = CurRec.Value
Application.ScreenUpdating = False
If WSR.Range("G6") <> "Submitted" Then
MsgBox "This request has already been reviewed & responded to."
Exit Sub
End If
Set WBD = Workbooks.Open(Filename:="G:\U\Dashboard\Time Off\Master\TOATData.xlsx")
Set WSData = WBD.Worksheets("Data") 'Data worksheet
'On Error GoTo 0
'Select the Data worksheet
WSData.Select
WSData.AutoFilter.ShowAllData
WSData.Select
FinalRow = WSData.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To FinalRow
If Cells(i, 1) = iRow Then
Cells(i, 14) = "Approved"
Cells(i, 15) = Cmt.Value
Cells(i, 16) = Now()
End If
Next i
WBD.Save
WSData.Cells.Copy
WBR.Activate
WSD.Select
Cells(1, 1).Select
Selection.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
WBD.Close True
WSD.Activate
WSD.Columns.AutoFit
WSD.Columns("M:M").ColumnWidth = 50
WSD.Range("A1").AutoFilter
WSD.Range("C2").Select
ActiveWindow.FreezePanes = True
WSR.Select
Cmt.Value = ""
Call StatusEmail
If CurRec < LastRec Then
CurRec = CurRec + 1
End If
Application.ScreenUpdating = True
End Sub
Thank you in advance!