For Loop Taking Too Long

[Peter.Stevens2]

Hi, I've got a sheet which I need to analyse and split into several different sheets but the raw data format leaves a lot to be desired as there are blank rows inserted randomly between rows of data. I need the 'good' data to stay in the same order so I've written a macro to sort through the data and delete any blank rows leaving the good stuff behind. The problem is this takes ages as there can be up to 30000 rows that need to be checked and I need to do this 5-6 times a day. I just wondered weather there was a quicker way to do this? The code I've got is detailed below:

Sub Prep2()
'Delete all blank data rows
Dim Rows As Double
Dim Rownum As Double
Application.ScreenUpdating = False
Rows = Selection.SpecialCells(xlLastCell).Row
 
For Rownum = 2 To Rows
    If Cells(Rownum, 11) <> "" Then GoTo NxtRownum Else
 
    Cells(Rownum, 11).EntireRow.Delete shift:=xlUp
 
    Rows = Rows - 1
NxtRownum:
Next Rownum
Application.ScreenUpdating = True
End Sub

Many Thanks for any help you can offer!

 

[VoG]

Try

Sub Prep2()
On Error Resume Next
Columns("K").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub

 

[Peter.Stevens2]

Thanks for the quick reply, the macro deletes all of the data on the sheet when I run it. Should I be looking at a specific cell rather than the whole column?

 

[VoG]

It is looking for blanks in column K which is what I believe your code was doing. If a blank is found in that column the whole row is deleted. Is that what you want?

 

[Peter.Stevens2]

Hi, That's exactly what I want to do and I can see your code would do that very quickly but when I run it I end up with a blank sheet where the raw data used to be. Could it be something to do with the format of the raw data, it's a Tab delimited file and I've had problems with this type of file before?

 

[VoG]

Maybe it is something about the structure of the file. See if this amendment to your original loop is any faster

Sub Prep2()
'Delete all blank data rows
Dim LR As Long, Rownum As Long
Application.ScreenUpdating = False
LR = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
For Rownum = LR To 2 Step -1
    If Cells(Rownum, 11).Value = "" Then Rows(Rownum).Delete
Next Rownum
Application.ScreenUpdating = True
End Sub

 

[Richard Schollar]

Hi

Give this a shot (may not do anything different from Peter's though):

Sub DeleteRows()
Dim r As Range
Rows(1).Insert
[K1] = "Header"
Set r = Application.Intersect(ActiveSheet.UsedRange,Range("K:K"))
r.Autofilter Field:=1,Criteria1:="="
r.EntireRow.Delete
End Sub

 

[Peter.Stevens2]

Hi,

Thanks VoG that ammendment was about 10 times quicker than mine, I think thats about as quick as I'm going to get it with the file issues I'm having, I think there is something about the way the raw data is constructed (downloaded from SAP) that makes it difficult to manipulate in Excel. 25 seconds to sort nearly 30000 records is much better than the 5 minutes I was waiting before, I really appreciate the help, I've been scratching my head over this one!

Kind Regards

Pete

 

[VoG]

Well that's an improvement but I would try Richard's code - it should be faster.

 

[Ragnar1211]

Based on this website, http://www.aivosto.com/vbtips/stringopt.html, we can enhance Vog's code a little more by using Lenb:

Sub Prep2()
'Delete all blank data rows
Dim LR As Long, Rownum As Long
Application.ScreenUpdating = False
LR = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
For Rownum = LR To 2 Step -1
    If lenb(Cells(Rownum, 11).Value) = 0 Then Rows(Rownum).Delete
Next Rownum
Application.ScreenUpdating = True
End Sub</pre>