Not sure why my simple copy rows is running so slowly

[LukeAvedon]

Hello,

Maybe someone here will be kind enough to help me.

I have a simple subroutine but it runs incredibly slowly.

I have one sheet CodeName "SellHack". For now there are about 700 Rows. About half of the records have "verified" listed on Column "O". I'm
trying to copy all of the rows that do NOT contain verified in column "O" (15).


When I run this code it takes about 5 minutes, which I find very strange. I have other subroutines that are even more poorly written by myself and don't have this problem.

Sub nonVerfiedEmailsNewSheet()


    Dim ws As Worksheet
    Dim wb As Workbook
    Dim i As Integer
    Dim wsRowCount As Integer
    
    Dim LastRow As Variant
    Dim rng As Range
    Dim rPlacementCell As Range
    Dim rFoundCell As Range
    
    'Call optimize code
    Call SetUp.OptimizeCode_Begin
    
               
    Set wb = ThisWorkbook
    i = wb.Worksheets.Count
    
        
    
        
    'Create a new sheet
    wb.Worksheets.Add After:=Worksheets(i)
    i = i + 1
        
    
    
    Set ws = wb.Worksheets(i)
    ws.Name = "All Non-Verified Emails"
    
    
    SellHack.Range("A1").EntireRow.Copy Destination:=ws.Range("A1")
   


    
    '**********Find all non-verfieid rows and copy*********
    
    
    'Find the last row of the sellhack sheet
    LastRow = SellHack.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    LastCol = SellHack.UsedRange.SpecialCells(xlCellTypeLastCell).Column
    
    
    'A simple loop that looks in each cell
    
    wsRowCount = 2
    For i = 2 To LastRow
        
        If LCase(Trim(SellHack.Cells(i, 15).Value)) <> "verified" Then
            With SellHack
                .Range(.Cells(i, 1), .Cells(i, LastCol)).Copy
            End With
                ws.Cells(wsRowCount, 1).PasteSpecial xlPasteValues
                wsRowCount = wsRowCount + 1
            End If
    Next i
        
    'Make the sheet readable
    ws.Columns.AutoFit
    
    Call SetUp.OptimizeCode_End
    
End Sub

I tried adding two other subs to turn off screenupdating, etc. but it's still incredibly slow.

Public CalcState As Long
Public EventState As Boolean
Public PageBreakState As Boolean


Sub OptimizeCode_Begin()


Application.ScreenUpdating = False


EventState = Application.EnableEvents
Application.EnableEvents = False


CalcState = Application.Calculation
Application.Calculation = xlCalculationManual


PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False


End Sub


Sub OptimizeCode_End()


ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True


End Sub

Thank you, any help is greatly appreciated.

 

[JimRau]

Instead of reading the worksheet one row at a time what if you made a copy of the worksheet and deleted the rows that have "verified" in column O?

 

[Michael M]

Maybe this to replace ALL of your codes !

Sub nonVerfiedEmailsNewSheet()
Dim ws As Worksheet, rng As Range, lr As Long
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
'Create a new sheet
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "All Non-Verified Emails"
lr = SellHack.Cells(Rows.Count, "A").End(xlUp).Row + 1
    With SellHack.Range("A2:O" & lr)
        .AutoFilter Field:=15, Criteria1:=""
        .SpecialCells(xlCellTypeVisible).Copy Sheets("All Non-Verified Emails").Range("A1")
        .AutoFilter
    End With
Sheets("All Non-Verified Emails").Columns.AutoFit
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

 

[LukeAvedon]

Hello thanks for your help and the quick reply!

Looks like I don't understand AutoFilter at all. That's the trick. Thanks again.

--Luke

 

[Michael M]

glad it helped...