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]

"Smaller" is not always "faster". Please try the following on a copy of your workbook.

Option Explicit
Sub Sufiyan97()
    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, 0
        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

 

[kevin9999]

If smaller is your priority, try this:

Sub Sufiyan97_small()
    With Sheets("PO").Range("A1").CurrentRegion
        .AutoFilter 8, 0
            .Offset(1).Resize(.Rows.Count - 1).Copy Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1)
            .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
End Sub

 

[Sufiyan97]

Thanks Kevin for looking into it, but It copies everything on the sheet.

I just want if any of the row in column H of PO sheet has 0 value, I just want to cut entire row and move it to Completed sheet and then delete that blank row in PO sheet.

Also please add the notes for each line (if possible) for what each line is doing.

Let me know if any other information is required.

 

[kevin9999]

Could you post a copy of your sheet using the XL2BB add in? When I tested it based on what I thought your data would look like it worked fine.

 

[Sufiyan97]

I just want to move the row which has current balance 0 in Completed sheet.

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	Something	Something	Original Amount	Something	Something	Something	Invoice	Current Balance	Something
2	Something	Something	100	Something	Something	Something	50	50	Something
3	Something	Something	100	Something	Something	Something	0	100	Something
4	Something	Something	100	Something	Something	Something	0	100	Something
5	Something	Something	100	Something	Something	Something	50	50	Something
6	Something	Something	100	Something	Something	Something	0	100	Something
7	Something	Something	100	Something	Something	Something	0	100	Something
8	Something	Something	100	Something	Something	Something	100	0	Something
9	Something	Something	100	Something	Something	Something	0	100	Something
10	Something	Something	100	Something	Something	Something	0	100	Something
11	Something	Something	100	Something	Something	Something	0	100	Something
12	Something	Something	100	Something	Something	Something	0	100	Something
13
14
15
PO

Cell Formulas
Range	Formula
H2:H12	H2	=C2-G2

 

[kevin9999]

Thank you for that. It'll be a few hours before I can get to look at this closely, although there's nothing immediately apparent as to why it didn't work.

 

[kevin9999]

OK, when I run the following code:

Option Explicit                                     '<-- Always use this, forces declaration of variables used
Sub Sufiyan97()
    Application.ScreenUpdating = False              '<-- Reduce screen flickering
    Application.Calculation = xlManual              '<-- Stop calculations while code is running
    Dim ws1 As Worksheet, ws2 As Worksheet          '<-- Declare the worksheet variables as type "Worksheet"
    Set ws1 = Worksheets("PO")                      '<-- Set ws1 to the worksheet called "PO"
    Set ws2 = Worksheets("Completed")               '<-- Set ws2 to the worksheet called "Completed"
    
    If ws1.AutoFilterMode Then ws1.AutoFilter.ShowAllData   '<-- Check if autofilter is switched on on the PO sheet, if it is then show alll data
    With ws1.Range("A1").CurrentRegion                      '<-- Set the range to "PO" sheet, contiguous data starting from cell A1
        .AutoFilter 8, 0                                    '<-- Filter column 8 (=H) by the value 0
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then    '<-- If any rows are found with this value in column 8...
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)  '<-- Offset by 1 row to exclude the headers, elimintae the empty row below the range and copy what's left to the Completed sheet - first available row
            .Offset(1).EntireRow.Delete                     '<-- Delete the filtered range i.e. any row where column 8 is 0
        End If
        .AutoFilter                                 '<-- Turn the autofilter off
    End With
    Application.Calculation = xlAutomatic           '<-- Turn calculations back to automatic
    Application.ScreenUpdating = True               '<-- Turn screen updating back on
End Sub

It turns your PO sheet from this:

Book1
	A	B	C	D	E	F	G	H	I
1	Something	Something	Original Amount	Something	Something	Something	Invoice	Current Balance	Something
2	Something	Something	100	Something	Something	Something	50	50	Something
3	Something	Something	100	Something	Something	Something	0	100	Something
4	Something	Something	100	Something	Something	Something	0	100	Something
5	Something	Something	100	Something	Something	Something	50	50	Something
6	Something	Something	100	Something	Something	Something	0	100	Something
7	Something	Something	100	Something	Something	Something	0	100	Something
8	Something	Something	100	Something	Something	Something	100	0	Something
9	Something	Something	100	Something	Something	Something	0	100	Something
10	Something	Something	100	Something	Something	Something	0	100	Something
11	Something	Something	100	Something	Something	Something	0	100	Something
12	Something	Something	100	Something	Something	Something	0	100	Something
13
PO

Cell Formulas
Range	Formula
H2:H12	H2	=C2-G2

To this:

Book1
	A	B	C	D	E	F	G	H	I
1	Something	Something	Original Amount	Something	Something	Something	Invoice	Current Balance	Something
2	Something	Something	100	Something	Something	Something	50	50	Something
3	Something	Something	100	Something	Something	Something	0	100	Something
4	Something	Something	100	Something	Something	Something	0	100	Something
5	Something	Something	100	Something	Something	Something	50	50	Something
6	Something	Something	100	Something	Something	Something	0	100	Something
7	Something	Something	100	Something	Something	Something	0	100	Something
8	Something	Something	100	Something	Something	Something	0	100	Something
9	Something	Something	100	Something	Something	Something	0	100	Something
10	Something	Something	100	Something	Something	Something	0	100	Something
11	Something	Something	100	Something	Something	Something	0	100	Something
12
PO

Cell Formulas
Range	Formula
H2:H11	H2	=C2-G2

And your completed sheet looks like this:

Book1
	A	B	C	D	E	F	G	H	I
1	Something	Something	Original Amount	Something	Something	Something	Invoice	Current Balance	Something
2	Something	Something	100	Something	Something	Something	100	0	Something
3
Completed

Cell Formulas
Range	Formula
H2	H2	=C2-G2

So I can't reproduce the issue you're having - as long as what you posted is exactly what your data looks like.

When I run this code:

Sub Sufiyan97_small()
    With Sheets("PO").Range("A1").CurrentRegion     '<-- set the range to the PO sheet, contiguous data starting from A1
        .AutoFilter 8, 0                            '<-- set the filter to column 8 (H) to = 0
            .Offset(1).Resize(.Rows.Count - 1).Copy Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1)  '<-- Offset, resize & copy to sheet Completed first available row
            .Offset(1).EntireRow.Delete             '<-- delete any row found with a 0 in column 8 (H)
        .AutoFilter                                 '<-- turn autofilter off
    End With
End Sub

I get exactly the same result.

 

[Sufiyan97]

Hi Kevin,

Thank you very much, I don't know how but when I tried code for the first time, it copied all the PO sheet data to Completed, now it works as expected.

and the big code is faster I think, is that correct?

 

[Sufiyan97]

Now I found the issue, my column H was formatted as Accounting and it did not work.

I tried formatting it as Number, still it did not work, but when I formatted the column H as General then it works.

Can we fix this?