Make the code small and Faster

[Sufiyan97]

I want to make this code smaller and faster

Thanks you for your help in this in advance.

Sub MoveData()
Dim r1, r2
' Determine that last row in the PO Sheet (r1)
Sheets("PO").Select
r1 = Range("A65536").End(xlUp).Row

Dim count As Long
For count = 2 To r1
    If Range("H" & count).Value = 0 Then
        Rows(count).EntireRow.Cut
        ' Determine that last row in the Completed Sheet (r2)
        Sheets("Completed").Select
        r2 = Range("A65536").End(xlUp).Row
        Rows(r2 + 1).EntireRow.Insert
        Sheets("PO").Select
        If Range("A" & count).Value = "" Then
        Rows(count).EntireRow.Delete
        
    End If
    End If
Next count
End Sub

 

[kevin9999]

The formatting shouldn't make any difference at all, the filter works on the value not the format of the cells in column H. To get to the bottom of the problem I would really need to see the actual file itself. Could you share via Dropbox, Google Drive or similar file sharing platform?

 

[Sufiyan97]

Here it is

Something PO.xlsm

PO Something,Something,Original Amount,Something,Something,Something,Invoice,Current Balance,Something Something,Something,100,Something,Something,Something,50,50,Something Something,Something,100,Something,Something,Something,0,100,Something Something,Something,100,Something,Something,Something...

docs.google.com

 

[kevin9999]

Thank you for that - I see what you mean now
I'm assuming all of column H is formatted Accounting. Try the following code - note the comment about changing the "$" symbol if required, and if no symbol is used then delete that line & uncomment the next (you'll see the notes in teh code).

Option Explicit
Sub Sufiyan97_V2()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("PO")
    Set ws2 = Worksheets("Completed")
    
    If ws1.AutoFilterMode Then ws1.AutoFilter.ShowAllData
    With ws1.Range("A1").CurrentRegion
        '.AutoFilter 8, " $-   "                           '<-- *** Change  the "$" symbol if required ***
        .AutoFilter 8, "-   "                              '<-- *** OR use this line instead if no symbol used ***
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
            .Offset(1).EntireRow.Delete
        End If
        .AutoFilter
    End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

 

[Sufiyan97]

Sorry, have been very busy since last few days, so could not reply.

Thank you very much for modifying the code to cover both.

Can we make it to look at the values and not formatting so that if someone forget to format the cell as accounting then also it works.

 

[kevin9999]

This should pick up either:

Option Explicit
Sub Sufiyan97_V3()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("PO")
    Set ws2 = Worksheets("Completed")
    
    If ws1.AutoFilterMode Then ws1.AutoFilter.ShowAllData
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 8, " $-   ", 2, 0                       '<-- *** Change  the "$" symbol if required ***
        '.AutoFilter 8, "-   ", 2, 0                        '<-- *** OR use this line instead if no symbol used ***
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
            .Offset(1).EntireRow.Delete
        End If
        .AutoFilter
    End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

 

[Sufiyan97]

Thank you very much @kevin9999 for your patience and multiple modifications in the code.

This works perfect.

 

[kevin9999]

You're welcome, and thanks for the feedback