How to make macro runs faster?-CodePudding

I was just wondering if I could speed up this macro?

`Columns("O:O").Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("N:O").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp`

I only want it to run to Row# 26 but when I tries to change it to O:O26 or N2:O26. I get error either "400" or "Type Mismatch".

Thank you in advanced.

CodePudding user response：

Delete Rows (Cells)

The Beginning

Sub TheBeginning()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    Dim fCell As Range: Set fCell = ws.Range("O2")
    Dim rg As Range
    Set rg = ws.Range(fCell, ws.Cells(ws.Rows.Count, fCell.Column).End(xlUp))

    ' Empty the cells containing zeros.        
    rg.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    ' add the code of the preferred option here...

End Sub

Option 1

Delete rows of empty cells in column O no matter what's in column N.

Sub Option1()
    
    ' Delete rows of empty cells in column 'O' no matter what's in column 'N'.
    
    Dim vrg As Range
    On Error Resume Next ' prevent error if no cells
        Set vrg = rg.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If vrg Is Nothing Then Exit Sub
    
    Dim drg As Range: Set drg = Union(vrg.Offset(, -1), vrg)
    
    drg.Select ' .Delete xlShiftUp
    
End Sub

Option 2

Delete rows of empty cells in columns N AND O.

Sub Option2()
    
    ' Delete rows of empty cells in columns 'N' AND 'O'.
    
    Dim drg As Range: Set drg = Union(rg.Offset(, -1), rg)
    
    Dim vrg As Range
    On Error Resume Next ' prevent error if no cells
        Set vrg = drg.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If vrg Is Nothing Then Exit Sub
    
    Dim ivrg As Range
    On Error Resume Next ' prevent error if no cells
        Set ivrg = Intersect(drg, Intersect(vrg, drg.Columns(1)).EntireRow, _
            Intersect(vrg, drg.Columns(2)).EntireRow)
    On Error GoTo 0
    If ivrg Is Nothing Then Exit Sub
    
    ivrg.Select ' .Delete xlShiftUp
    
End Sub

Option 3 Wrong

Delete rows of empty cells in columns N OR O (WRONG). I tagged it wrong because it will delete cells in each column independently and I consider it highly unlikely that's what is needed although it is a valid option.

Sub Option3Wrong()
    
    ' Delete rows of empty cells in columns 'N' OR 'O' (WRONG).
    
    Dim drg As Range: Set drg = Union(rg.Offset(, -1), rg)
    
    Dim vrg As Range
    
    On Error Resume Next ' prevent error if no cells
        Set vrg = drg.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    
    If vrg Is Nothing Then Exit Sub
    
    vrg.Select ' .Delete xlShiftUp
    
End Sub

Option 3

Delete rows of empty cells in columns N OR O.

Sub Option3()
    
    ' Delete rows of empty cells in columns 'N' OR 'O'.
    
    Dim drg As Range: Set drg = Union(rg.Offset(, -1), rg)
    
    Dim vrg As Range
    On Error Resume Next ' prevent error if no cells
        Set vrg = drg.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If vrg Is Nothing Then Exit Sub
    
    Set vrg = Intersect(vrg.EntireRow, drg)
    
    vrg.Select ' .Delete xlShiftUp
    
End Sub

Tips

Note how the ISBLANK columns get all messed up after the cells get shifted. That is something to keep in mind when not deleting entire rows.
When developing a code that deletes, it is advisable to use Select instead of Delete. Of course, you need to keep in mind that the worksheet needs to be active to be able to use it in this simple form. You can improve it with:
```
If not wb Is ActiveWorkbook Then wb.Activate
If Not ws Is ActiveSheet Then ws.Select
```