2

I am trying to delete all cells =0 in a column in my spreadsheet and "summon" the values which don't to the top of the column.

I am currently using

Dim row_index As Integer
Dim col_index As Integer

row_index = 7
col_index = 16

Application.ScreenUpdating = False 'turns off screen updates

While Cells(row_index, col_index) <> ""
    If Cells(row_index, col_index) = 0 Then
        Cells(row_index, col_index).Delete
    Else
        row_index = row_index + 1
    End If
Wend

Application.ScreenUpdating = True 'turns screen updates back on

But even with screen updating off it is very slow as the datasets are between 500-3500 points. Is there a better way to do this or any other tips to speed it up?

Thanks

Edit: there are a few solutions on the web but they all seem to involve blanking cells or deleting rows. I only want to delete cells and then shift cells up.

Community
  • 1
  • 1
Cassiopeia
  • 313
  • 1
  • 4
  • 16

4 Answers4

8

Deleting cells in a loop can really be very slow. What you could do is identify the cells that you want to delete in a loop and then delete them in one go after the loop. Try this.

Option Explicit

Sub Sample()
    Dim row_index As Long, lRow As Long, i As Long
    Dim ws As Worksheet
    Dim delRange As Range

    '~~> Change this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    row_index = 7

    Application.ScreenUpdating = False

    With ws
        lRow = .Range("P" & .Rows.Count).End(xlUp).Row

        For i = row_index To lRow
            If .Range("P" & i).Value <> "" And .Range("P" & i).Value = 0 Then
                If delRange Is Nothing Then
                    Set delRange = .Range("P" & i)
                Else
                    Set delRange = Union(delRange, .Range("P" & i))
                End If
            End If
        Next
    End With

    If Not delRange Is Nothing Then delRange.Delete shift:=xlUp
    Application.ScreenUpdating = True
End Sub
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • @siddharth This works well, thanks. Is there a way which I can set it to run on the active worksheet? This sub is Called by another macro which selects the worksheet and then runs it across six worksheets. This makes it inconvenient to specify ws as a constant. thanks – Cassiopeia Nov 19 '13 at 18:10
  • @Cassiopeia: Change `Set ws = ThisWorkbook.Sheets("Sheet1")` to `Set ws = ThisWorkbook.Activesheet` – Siddharth Rout Nov 19 '13 at 18:13
2

Autofilter solution

Dim rng1 As Range
Set rng1 = Range([p7], Cells(Rows.Count, "p").End(xlUp))
ActiveSheet.AutoFilterMode = False
With rng1
.AutoFilter Field:=1, Criteria1:="0"
.Delete xlUp
End With
brettdj
  • 54,857
  • 16
  • 114
  • 177
  • + 1 :) I had thought of autofilter but was disappointed with the speed with a sample of 1000000 rows. Autofilter works very slow on huge rows. Autofilter would definitely go "easy" on just 3k rows :) – Siddharth Rout Nov 20 '13 at 07:46
-1

To speed things up, you probably also want to turn auto calculation off while you do the update:

Application.Calculation = xlCalculationManual

Then change it back to automatic when you are done:

Application.Calculation = xlCalculationAutomatic
Roberto
  • 2,054
  • 4
  • 31
  • 46
-2

Yes, there is:

Sub DoMAcro()
    Dim lastRow As Integer

    lastRow = Cells(1000, 16).End(xlUp).Row

    Range(Cells(7, 16), Cells(lastRow, 16)).Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
Makah
  • 4,435
  • 3
  • 47
  • 68
  • 1
    It looks like this just changes the cell value to blank without shifting cells up? – Cassiopeia Nov 19 '13 at 17:55
  • True. I misunderstood your question. I don't like to delete cells. It changes the real data. I prefer to mantain my DB and make report view or filter data, something like that. – Makah Nov 19 '13 at 17:58