Searching for and deleting xlCellTypeBlanks

foxsansbox

New member
Joined
Sep 28, 2015
Messages
13
Reaction score
0
Points
0
Hey guys, first post here.

I'm struggling with something I decided to do on my own time to expedite my work pulling reports and formatting data.

The section I'm getting an error on below is right here. The problem is is it works JUST fine on a smaller file, it handled 120,000 cells with ease. The file it's failing on is closer to 400,000. I'm not even sure the problem is the size. I just don't know why it would be throwing any kind of error. It's supposed to select all blank cells and just shift up to condense all the data. If anyone has any ideas on how to fix this I would be super appreciative.

GetInline.aspx
 
Tried editing multiple times, new user privileges leave much to be desired. This is the code.

Sub quickClean()Dim lastRow As Long


With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A" & lastRow).Select


Dim rng As Range


Set rng = Range("A1" & lastRow).SpecialCells(xlCellTypeBlanks)


rng.Rows.Delete Shift:=xlShiftUp
End Sub
 
Perhaps something like this will do what you want

Code:
Sub quickClean()
    Dim ws As Worksheet
    Dim lastRow As Long
    
Application.ScreenUpdating = False

Set ws = Sheets("Sheet1")      '<--alter as needed

With ws
    lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    'filter for column with the blanks
    .Range("A1:A" & lastRow).AutoFilter field:=1, Criteria1:="="
    'delete all visible rows except header
    On Error Resume Next    'in case there are none to delete
    'alter top row to exclude header
    .Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0         'turn error checking back on
    'remove filter
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True

End Sub
 
Perhaps something like this will do what you want

Code:
Sub quickClean()
    Dim ws As Worksheet
    Dim lastRow As Long
    
Application.ScreenUpdating = False

Set ws = Sheets("Sheet1")      '<--alter as needed

With ws
    lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    'filter for column with the blanks
    .Range("A1:A" & lastRow).AutoFilter field:=1, Criteria1:="="
    'delete all visible rows except header
    On Error Resume Next    'in case there are none to delete
    'alter top row to exclude header
    .Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0         'turn error checking back on
    'remove filter
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True

End Sub

I appreciate the timely response, and I will try this first chance I get tomorrow, however, Did you notice something glaringly wrong with what I put up? It did indeed work for multiple files, just not the very long one.
 
however, Did you notice something glaringly wrong with what I put up?
Possibly a few (whether glaring or not depends on the experience of the viewer!).



I just don't know why it would be throwing any kind of error.
Always useful for us to know what the error was.



It's supposed to select all blank cells and just shift up to condense all the data.
Just confirm that you're not seeking to retain row integrity, that is data on any given row stays together on a row. It's unusual if you don't, but come back and I'll cater for it. I suspect you do want to retain row integrity so I'll stick with that at the moment.

When debugging/developing, it can be useful temporarilyto intersperse your code with some extra lines; I often use .Select so that I can be sure that what I think my code is referring to, actually is (this needs you to step through the code one line at a time with F8). So in yor code I might add the following red lines:

Sub quickClean()
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A" & lastRow).Select 'you already put this one in.. but notice it's a little different from below where you have 'A1' instead of just 'A'.
Dim rng As Range
Range("A1" & lastRow).Select 'the same as below.
Set rng = Range("A1" & lastRow).SpecialCells(xlCellTypeBlanks)
rng.Select
rng.Rows.Select

rng.Rows.Delete Shift:=xlShiftUp
End Sub


The first red line above may surprise you with what it selects; let's say it previously found lastRow to be 500, what it will select is Range("A1" & 500), which is Range("A1500"), a single cell some 1000 rows below the lastRow!
The fact that it's a single cell is important when it comes to the SpecialCells operation; SpecialCells will assume you want SpecialCells from the entire sheet!

The code you supplied implies (from rng.rows.delete) that you only want to find blanks in column A and delete the rows that they're on, and I'm guessing complete rows from the table or even entire rows on the sheet - you'll have to fill us in.
So this is a guess:
Code:
Sub quickClean2()
Dim lastRow As Long
With ActiveSheet
  lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A2:A" & lastRow).Select 'can delete later
Dim rng As Range
Set rng = Range("A2:A" & lastRow).SpecialCells(xlCellTypeBlanks)
rng.Select 'can delete later
rng.EntireRow.Select 'can delete later
rng.EntireRow.Delete
End Sub

A couple more things to note:
1. You used With ActiveSheet; the End With could be placed a little lower in the code - it would make the code a little more robust. (Actually it makes very little difference. One instance where it would foul up is if this code is in a sheet's code-module which is not the active sheet's code-module.)
2. It might be that column A has no blank cells at all, in which case the SpecialCells operation will throw an error which you might want to cater for.
Both these points addressed below:
Code:
Sub quickClean3()
Dim lastRow As Long, rng As Range

With ActiveSheet
  lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  On Error Resume Next  'next line might error.
  Set rng = .Range("A2:A" & lastRow).SpecialCells(xlCellTypeBlanks)
  On Error GoTo 0  'restore normal error operations.
  If Not rng Is Nothing Then rng.EntireRow.Delete
End With
End Sub
 
Last edited:
Possibly a few (whether glaring or not depends on the experience of the viewer!).

Always useful for us to know what the error was.

I'm so sorry. I had a fancy snippet with the error and everything, but excelguru doesn't think I should be allowed to post pictures yet, which is why I typed out the code by hand. I am also very inexperienced at this point, I have self taught myself via the macro function, stackoverflow/excelguru code hunting, and trial and error to create my current project, which we shall call Frankensteins monster.

And I am in fact NOT looking for row integrity. All the information ends up in column A by the time I am done anyway. It would be hard to explain why I'm doing this without a few lengthy paragraphs, but essentially columns A through D are all the same type of data, and they need to be trimmed, cleaned, and condensed on A before I can begin doing some other data stuff.

Thank you both for the responses, you've given me a lot ot work with, think about. I'm going to get started now.
 
Last edited by a moderator:
Read your comments again and felt I should elaborate a little more. I have 4 columns with data, all of the same type, all seperated by varying degrees of blank cells (Not the fun kind of blank cells, the kind that have to be trimmed first). My original code would shift through cell by cell and test it to be blank and then delete shift up if found empty, and as you can imagine this would take some time. For the first file it took 40 seconds. For the Second file it took THREE hours. This was no good so I sought out to teach myself more. Currently I have the first file down to three seconds, which prompted me to retest the second one, which is when things started goofing and I sought out the help of you fine folk.
 
400,000 cells in total (rather than 4 columns of 400,000 = 1,600,000) eh?
Order of the cell not matter?
Then put the 4 columns in column A first, sort, delete (if necessary) stuff at the top/bottom?

Something like the following might work
Code:
Sub blah()
With ActiveSheet
  For colm = 2 To 4
    Set Destn = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
    'Destn.Select
    SourceLastRow = .Cells(.Rows.Count, colm).End(xlUp).Row
    '.Range(.Cells(1, colm), .Cells(SourceLastRow, colm)).Select
    .Range(.Cells(1, colm), .Cells(SourceLastRow, colm)).Cut Destn
  Next colm
  SortLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  With .Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("A1:A" & SortLastRow)
    .Header = xlNo  ' could be xlYes or xlGuess depending..
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  Z = Range("A1:A" & SortLastRow).Value
  For j = 1 To UBound(Z)
    If Application.Trim(Z(j, 1)) <> "" Then Exit For
  Next j
  .Range("A1:A" & j - 1).Delete shift:=xlUp
End With
End Sub
Assumes no column headers.
2 seconds for 4 x 100,000 rows with 7% 'fun' blank cells, 7% true blank cells
 
Last edited:
I just finished! I repurposed your last code a bit and I got it to work. No crashing and it finished in under 15 minutes (Compared to 3 hours I'm really excited). This is what I ended up using.

Code:
Sub quickClean2()
Dim lastRow As Long
With ActiveSheet
  lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A1:A" & lastRow).Select 'can delete later
Dim rng As Range
Set rng = Range("A1:A" & lastRow).SpecialCells(xlCellTypeBlanks)
rng.Select 'can delete later
rng.Cells.Delete
With ActiveSheet
  lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Range("B1:B" & lastRow).Select 'can delete later
Set rng = Range("B1:B" & lastRow).SpecialCells(xlCellTypeBlanks)
rng.Select 'can delete later
rng.Cells.Delete
With ActiveSheet
  lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
End With
Range("C1:C" & lastRow).Select 'can delete later
Set rng = Range("C1:C" & lastRow).SpecialCells(xlCellTypeBlanks)
rng.Select 'can delete later
rng.Cells.Delete
With ActiveSheet
  lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With
Range("D1:D" & lastRow).Select 'can delete later
Set rng = Range("D1:D" & lastRow).SpecialCells(xlCellTypeBlanks)
rng.Select 'can delete later
rng.Cells.Delete
End Sub

I had a follow up question if you don't mind me picking your brain. I changed rng.EntireRow.Delete to rng.Cells.Delete because when I was going through it step by step like you suggested I saw how it was working and selecting things and I thought this might be faster in the long run (Running tests both ways it turns out this was false, both took approximately 13 to 14 minutes). My question is, Collumn A was nearly instant, B took almost 10 minutes, C 3 minutes, and D 1 minute. D by FAR had the most blank cells, and A by FAR the least blank cells (This is by nature true for every report I pull in this manner). Why would they both be the fastest? I'm trying to understand how data/resources are being handled because I'm going to end up making more macros like this.

If your latest suggestion would be logically faster than the 13-15 minutes I'm getting now I will redo it again, but as it stands you have been so helpful and its made my day. Thank you.
 
Last edited by a moderator:
I changed rng.EntireRow.Delete to rng.Cells.Delete because when I was going through it step by step like you suggested I saw how it was working and selecting things and I thought this might be faster in the long run (Running tests both ways it turns out this was false, both took approximately 13 to 14 minutes).
change it to rng.Delete.

My question is, Column A was nearly instant, B took almost 10 minutes, C 3 minutes, and D 1 minute. D by FAR had the most blank cells, and A by FAR the least blank cells (This is by nature true for every report I pull in this manner). Why would they both be the fastest? I'm trying to understand how data/resources are being handled because I'm going to end up making more macros like this.
I don't know, but I'd speculate it was to do with the number of contiguous areas rather than the total number of cells being deleted; 2 areas of 500 cells each is probably going to delete and shift up faster than 1000 non-contiguous cells.

Does the order of the final cells matter, and are they still all going to end up in column A?
And are we talking 400k cells or 1600k cells?
 
change it to rng.Delete.

I don't know, but I'd speculate it was to do with the number of contiguous areas rather than the total number of cells being deleted; 2 areas of 500 cells each is probably going to delete and shift up faster than 1000 non-contiguous cells.

Does the order of the final cells matter, and are they still all going to end up in column A?
And are we talking 400k cells or 1600k cells?

This particular report is going to be 500,000. But the number can fall anywhere between 30,000 and over a million. This is just the largest file I've received to date.

They still end up in column A and the order does not matter, I create a Pivot table to sort them by count later.

Edit: My macro does successfully do all the rest, putting it all on A, formatting, and creating the Pivot table.
 
Last edited by a moderator:
Condensing your code:
Code:
Sub quickClean2c()
With ActiveSheet
  For i = 1 To 4
    .Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp)).SpecialCells(xlCellTypeBlanks).Delete
  Next i
End With
End Sub
Might run a bit faster simply because no selection takes place (It's the .delete lines which is slow in your code).
You might see some speed improvement if you start the macro with:
Application.screenupdating=false
and finish it with:
Application.screenupdating = true

I wouldn't be happy with a 15 minute procedure to do this. Mine is fast-ish only because it only deletes one contiguous area, due to the data being sorted, and excel is quite fast at sorting.

edit:
Just a minute:
I create a Pivot table to sort them by count later.
you just want a count of the unique items?!
This puts the list and count in F2:G2 and below of the same sheet:
Code:
Sub blah()
Dim ResultContent(), ResultCount()
ReDim ResultContent(1 To 1)
ub = 0
With ActiveSheet
  Set myrng = .Range("A1").CurrentRegion
  Z = myrng.Value
  For Each itm In Z
    If Not IsEmpty(itm) Then
      If Application.Trim(itm) <> "" Then
        x = Application.Match(itm, ResultContent, 0)
        If IsError(x) Then
          ub = ub + 1
          ReDim Preserve ResultContent(1 To ub)
          ReDim Preserve ResultCount(1 To ub)
          ResultContent(ub) = itm
          ResultCount(ub) = 1
        Else
          ResultCount(x) = ResultCount(x) + 1
        End If
      End If
    End If
  Next itm
  .Range("F2").Resize(UBound(ResultContent)) = Application.Transpose(ResultContent)
  .Range("G2").Resize(UBound(ResultContent)) = Application.Transpose(ResultCount)
End With
End Sub
 
Last edited:
Did you try ?

Code:
sub M_snb()
   columns(1).resize(,4).specialcells(4).entirerow.delete
End Sub

NB. Please, do not quote.
 
Already have the screen updating thing, and now I'm down to 12 minutes with your loop suggestion for my clean (I couldn't figure out how to iterate through columns by their index value which is why I didn't even get to it myself, it was going to be my next question.

And no I don't just want the count of unique items! There's a whole lot more going on, because the data has to be formatted and mapped and all sorts of things after I've had my hands on it.

But my first iteration of this program took 3 hours (I'm not going to say how I went about finding blank cells *cough*one at a time*cough*), and now it's down to 12 minutes so can I be happy yet? :p

I'm also learning a ton.
 
Last edited by a moderator:
snb, I tried yours. It encountered a runtime error and I'm not sure why.
 
And no I don't just want the count of unique items! There's a whole lot more going on, because the data has to be formatted and mapped and all sorts of things after I've had my hands on it.
<snip>
and now it's down to 12 minutes so can I be happy yet?
Then why don't you reduce it to a few seconds by using the blah macro in msg#8?




ps. please don't quote entire previous messages unless it is really necessary.
 
Sorry about forum etiquette. No more big quotes.

I didn't use msg 8 because at the time I didn't understand what it did, I still don't entirely but I have a much better idea now.

It errors out on
Code:
.Range("A1:A" & j - 1).Delete shift:=xlUp

Run time error 1004
 
It errors out on
Code:
.Range("A1:A" & j - 1).Delete shift:=xlUp
Run time error 1004
I bet j=1 at that time which means there were no 'fun' blank cells at the top of column A after sorting - I should have thought about that possibility.
Change that line to:
If j > 1 Then .Range("A1:A" & j - 1).Delete shift:=xlUp
 
Back
Top