VBA to delete blank rows and rows where # characters in row A = 9

[roberttkim]

Hi Excel experts hoping someone can help me as I am in quite a jam. I have about 300K rows. I searched around and found a macro that does the job using auto filter but it is SO SLOW and sometimes blows up my excel.

Could someone please help and post a macro that will delete all blank rows and also any rows where the value in column A for each cell does not have 9 characters or (len(A) <> 9)

Please please help.

 

[PCL]

See next code

Option Explicit


Sub Treat()
Dim WkArr()
Dim WKRg  As Range
Dim I  As Long
    Set WKRg = Range([A1], Cells(Rows.Count, "A").End(3))
    WkArr = WKRg
    For I = 1 To UBound(WkArr, 1)
        If (Len(WkArr(I, 1)) <> 9) Then WkArr(I, 1) = ""
    Next I
    Cells(1, 1).Resize(UBound(WkArr, 1), 1) = WkArr
    WKRg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'
End Sub

 

[PCL]

Another one perhaps faster

Option Explicit


Sub Treat()
Dim WkArr()
Dim WKRg  As Range
Dim I  As Long
    Application.ScreenUpdating = False
    Set WKRg = Range([A1], Cells(Rows.Count, "A").End(3))
    WkArr = WKRg
    For I = 1 To UBound(WkArr, 1)
        If (Len(WkArr(I, 1)) <> 9) Then WkArr(I, 1) = ""
    Next I
    Cells(1, 1).Resize(UBound(WkArr, 1), 1) = WkArr
    WKRg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

 

[vcoolio]

Hello Robert,

When deleting rows with such a large data set, there are thousands upon thousands of iterations continuously taking place over the size of the data set. Its a major drain on resource so will take many minutes to complete.

A quicker option would be to clear the contents of the relevant rows and then sort the data to place all the empty rows at the bottom of the data set. The end result is pretty much the same.

Following is a code I wrote for another Poster elsewhere about a year ago which worked just fine for her. It took about 5 - 6 seconds to complete over about 330K rows. I've modified it a little to suit your criteria:-

Sub DeleteStuff()

        Dim lr As Long
        lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

Sheet1.Range("J2:J" & lr) = "=Len(A2)"

With Sheet1.Range("J1", Sheet1.Range("J" & Sheet1.Rows.Count).End(xlUp))
        .AutoFilter 1, "<>" & 9
        .Offset(1).EntireRow.ClearContents
        .AutoFilter
End With

Sheet1.Columns(10).ClearContents
Sheet1.Range("A2", Sheet1.Range("H" & Sheet1.Rows.Count).End(xlUp)).Sort Sheet1.[A2], 1


Application.ScreenUpdating = True

End Sub

The code covers data from Columns A:H. It also uses a helper column(J) into which a formula is placed to determine the number of characters in each cell of Column A. It then filters on "<>9".

This may be another option for you.

I've attached a sample file with dummy data holding approx. 330K rows of data from Columns A:H at the following link:-

http://ge.tt/2Gmb0vq2

I don't know what sheet you are referencing so I've used the sheet code (Sheet1) in the code above. You could use ActiveSheet instead or the actual name of your sheet.

I hope that this helps.

Cheerio,
vcoolio

 

[PCL]

Following vcoolio recomendations another code: Really faster ...!
It works for the activesheet

Option Explicit
Option Base 1


Sub Treat()
Dim WkArr()
Dim WKRg  As Range
Dim I  As Long, LC As Integer, LR As Long, LLR As Long
Const WkWd = "ZZZZZZZZZZZZ"


    Application.ScreenUpdating = False
    If (ActiveSheet.AutoFilterMode) Then ActiveSheet.AutoFilterMode = False '  REMOVE  AUTOFILTER  IF  EXIST


    Set WKRg = ActiveSheet.UsedRange
    LLR = Cells(Rows.Count, 1).End(3).Row
    
    WkArr = WKRg
    ReDim Preserve WkArr(UBound(WkArr, 1), UBound(WkArr, 2) + 1)
    LC = UBound(WkArr, 2)
    For I = 1 To UBound(WkArr, 1)
        If (Len(WkArr(I, 1)) = 9) Then WkArr(I, LC) = WkWd
    Next I
    Cells(1, 1).Resize(UBound(WkArr, 1), LC) = WkArr
       
    Set WKRg = Range(Cells(1, LC), Cells(LLR, LC))
    Range(Columns(1), Columns(LC)).AutoFilter
    With ActiveSheet.AutoFilter.Sort
        .SortFields.Add2 Key:=WKRg _
        , SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
        
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    LR = Cells(Rows.Count, UBound(WkArr, 2)).End(3).Row
    
    Range(Cells(LR + 1, 1), Cells(LLR, 1)).EntireRow.Delete
    
    Columns(LC).Delete
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another option, based on vcoolio's suggestion

Sub DelRws()
   Dim LC As Long
   Application.ScreenUpdating = False
   With ActiveSheet
      LC = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Column
      With .Range(.Cells(2, LC), .Cells(.UsedRange.Rows.Count, LC))
         .Value = Evaluate(Replace("if(len(@)<>9,true,row(@))", "@", .Offset(, -LC + 1).Address))
         .SpecialCells(xlConstants, xlLogical).ClearContents
      End With
      .UsedRange.Sort key1:=Cells(1, LC), order1:=xlAscending, Header:=xlYes
      .Columns(LC).Clear
   End With
End Sub

 

[roberttkim]

Fluff thank you. This one is fast but it deletes all the data in column B as well. I have data in column A and B. Sometimes Column A is blank but data is in column B and sometime vise versa. Sometimes the entire row is blank. All this spans 300K rows. Can you help adjust?

 

[PCL]

roberttkim
How is running the code sent? I have not seen any time difference !
PCL

 

[Fluff]

@roberttkim
In your op you said to delete all rows where col A was not 9 characters in length. Now you say that sometimes col A is blank & data is in col B.
Can you please clearly define your requirements.

 

[roberttkim]

@Fluff apologies for any confusion. So my data is basically a text to column of very large statement file. The result is data in column A and column B but lots of empty rows in between rows of data. There are a lot of rows which are blank, rows which have data in column A and rows that have data in column in B, and rows that have data in both column A and column B. I really need a fast macro that will delete all blank rows AND check if there is data in column A that is not LEN(A) = 9 to delete that row as well. Hope this makes sense and apologies for any confusion. So at the end of the day I would have no blank rows in between rows with data and everything in column A = LEN(A) = 9 or is 9 characters.