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.

 

[roberttkim]

@PCL Thank you for your code but I get a debug error with your code stating runtme error '9' Subscipt out of range at:

ReDim Preserv WkArr(UBound(WkArr,1),UBound(WkArr, 2) + 1

 

[Peter_SSs]

.. 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.

That red specification seems needless to me. If the row is blank then column A in that row must be blank which means column A in that row is not 9 characters so would be deleted by the blue specification anyway.

See how this goes. For me it did 300,000 rows where about 8 out of 9 rows met the deletion criteria in less than 1 second.

I assumed that there was a heading in row 1 so this acts from row 2 down. If no heading row then change the red 2's below to 1.

Sub Del_Non_9Characters()
  Dim a As Variant, b As Variant
  Dim nc As Long, lr As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  a = Range("A2:A" & lr).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If Len(a(i, 1)) <> 9 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

 

[PCL]

Will you check the code it seems the satetement is not the right one: See "Preserve"

[COLOR=#333333]ReDim Preserve WkArr(UBound(WkArr,1),UBound(WkArr, 2) + 1[/COLOR]

 

[roberttkim]

Wow Peter. That worked great!! Also super super fast. Thank you so much!!

 

[Peter_SSs]

Wow Peter. That worked great!! Also super super fast. Thank you so much!!

Good news! You are very welcome.

 

[roberttkim]

Peter your macro is awesome. Would you also be so kind as to add one more piece. After your macro, I have data in column A and B. From the results of the macro you created for me, I then need to delete and rows that are not numbers. Would you be so kind as to help me with that last piece?

 

[Peter_SSs]

After your macro, I have data in column A and B. I then need to delete and rows that are not numbers.

1. Do we have to look for the numbers/not numbers in column A, column B or both columns A & B?

2. To be sure it is clear, could we have 5-10 rows of sample dummy data and make it clear which rows should be deleted from it?

3. Do we have to do this "after" the other macro, or could we do it at the same time?