Remove blank rows for large data set

[artz]

Hi,

I've got a data worksheet with over 1 million rows. I need to remove blank rows so that I can chart the data. The following code worked fine for worksheets with tens of thousands of rows but Excel stops responding when the data set goes into the hundreds of thousands of rows:

Sub DeleteRowIfCellBlank()
    On Error Resume Next
 
    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Can anyone in the Forum provide code that will work well with with a large data set? Any help is greatly appreciated.

Thanks,

Art

 

[Fluff]

Why not sort the data so the blank rows go to the bottom?

 

[artz]

That sounds interesting; I'll try it but what are the sort criteria? -Art

 

[Fluff]

Sort on column A doesn't matter if you use ascending, or descending.

 

[artz]

That didn't quite work. The data format looks like this:

Time	Flow1 	Flow2
	-0.02442	0.02442
		
		
		
		
		
	-0.02442	0.02442
		
		
		
		
		
	-0.02442	0.02442

When I run sort on column B (Column A is blank right now), the sort looks like this:

Time	Flow1 	Flow2
	-100	-15.995116
	-100	-16.092796
	-100	-16.190476
	-100	-16.190476
	-100	-16.141636
	-100	-15.995116
	-100	-15.897436

Maybe I am doing something wrong? Suggestion? Thanks, -Art

 

[mohadin]

Hi
In an empty column (second cell)put this formula and drag to the end of you data

=IF(b2="","",ROW()+1)

The do the sort on this column

 

[artz]

Hi mohadin, thanks for your response. I just tried out your formula and there's one small issue. It takes a lot of mouse gymnastics to drag down to the end of a million rows. (never made it) Do you have suggest on an easier way to fill down? Thanks, -Art

 

[mohadin]

Hi
Use this code to fill down the formula

Sub filldown()
    With Cells([COLOR=#ff0000]2, 8[/COLOR]).Resize(Cells(Rows.Count, 2).End(xlUp).Row)
        .Formula = "=IF(b2="""","""",ROW()+1)"
        .Value = .Value
    End With
End Sub

 

[Peter_SSs]

This should be considerably faster.

Sub Del_Blank_Rows()
  Dim a, b
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If Len(a(i, 1)) = 0 Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[mohadin]

Hi
Ok,
With this code Just filter without deleting rows(instead of manual filter)

Sub filldown()
    Dim lr
    lr = Cells(Rows.Count, 2).End(xlUp).Row - 1
    With Cells(2, 8).Resize(lr)
        .Formula = "=IF(b2="""","""",ROW()+1)"
        .Value = .Value
    End With
    With Range("A2").Resize(lr, 8)
        .Select
        .Sort Key1:=.Columns(8), Order1:=xlAscending, Header:=xlNo
    End With
End Sub