Is There A Faster Way To Do This?

CaliKidd · Sep 6, 2011

I am using Excel 2007 and the following code to find blank/empty cells in a large column of data. If blanks exist, I use a variable to count the number of them and I highlight the cell using a sub.

The problem is this loop is slow because it requires every cell to be scanned. Is there a faster way, perhaps using a range object, variant array, find, intersect/union, etc? Unfortunately, I am not well-versed in these so I need some assistance.

For reasons I won't elaborate on, I do not want to use a conditional formatting solution.

Code:

For Each Scanned_Cell In Range("A5:A1000000")
[INDENT]Scanned_Cell.Select
If Len(Trim(Scanned_Cell)) = 0 Then
[INDENT]Scanned_Cell.Select
Call Highlight_Cell
Blanks = Blanks + 1
[/INDENT]End If
[/INDENT]Next

Also, instead of finding blank cells, what mods would be required if I wanted to:
1. Assuming the data is numeric, find any cell with a specific value (e.g., 0 (zero))?
2. Assuming the data is numeric, find any cell with a value greater than a certain number (e.g., > 1)?
3. Assuming the data is string, find any cell that is not equal to the letter "A", "B" or "C"?

Thanks in advance.

mirabeau · Sep 7, 2011

Peter,

"Using many of the concepts of mirabeau's code, but with some slight variations, on my sample data (about 1/3 of the cells are blank) this takes only about half as long."

Just curious about this statement.
so I generated a bit of test data (with about 1/3 blank cells out of about one million) with a test data code

Code:

With Range("A5:A1000000")
    .Cells = "=if(rand()>.33,int(rand()*50),"""")"
    .Value = .Value
End With

and ran the code you provided and the code I provided three times each.
Peter_SSs code timed: 9.03secs, 9.04secs, 9.11secs
mirabeau code timed: 5.74secs, 5.75secs, 5.73secs
Am I wrong somewhere? but would you like to expand on your "... takes only about half as long", since this doesn't seem to be correct?
The special cells approach (unmodified) took me about 8 seconds on the same data.

CaliKidd,

If you like the idea of using autofilter on this sized problem then I wish you good luck!!

CaliKidd · Sep 7, 2011

mirabeau said:
Peter,
CaliKidd,

If you like the idea of using autofilter on this sized problem then I wish you good luck!!

Well, I like the idea of using Excel's native autofilter technology, but I don't know if there are mean, ugly monsters waiting for me in the code world. I'm too naive at this point to know any better.

My comment was simply based on the fact that I was just playing with the autofilter directly in Excel and it seemed fast and powerful. I like the fact I could filter in multiple ways. Now, how to step through those filtered cells like Rorya described is a mystery to me.

At the end of the day, I'll be happy with any solution that is faster than my current incremental VBA loop. I'd still be interested in how to accomplish 1, 2, and 3 using your approach. If an autofilter solution arises, then I'd like to evaluate it too, and also to learn from it by studying the code.

mirabeau · Sep 7, 2011

hey CaliKidd,

You have to try whatever you feel inclined to do. That's how we all learn things.

I certainly don't want to discourage you from anything at all.

With your 1. 2 and 3 problems and the code I gave, my preliminary thoughts were using the Match function and/or a bit of extension/variation of the sort-based code. Details would really depend on any example data you provided.

But if you get other good answers in the meantime, I'd be very happy with that. I can't do anything more for some time anyway.

CaliKidd · Sep 7, 2011

Mirabeau,

Thanks for your support. This forum really helps. I've read several 3" thick books on VBA, which have helped me learn the core concepts and basic fundamentals, but now I'm looking for some better solutions to specific problems. In most cases, I've hacked out a brute force solution, but it's slow/inefficient. It's ok with small data sets, but it drags with large ones. Hence, my search for a better way.

One thing I've learned by interacting with people on this forum is there are many different ways to getting a job done. There are a lot of smart people on this forum. When I interact with people more advanced than myself, such as yourself, it really helps in my development. I've learned more in 100 posts than I have reading 5,000+ book pages! When I step through people's code, I'm always impressed at the way they approached the problem. Definitely lots of wisdom gained. I hope one day soon I can help others too.

The data involved in #1 and #2 is purely numeric. I'm either trying to find cells with a specific value or trying to find cells that satisfy a particular condition (<, >, <>, etc.). Think: test scores.

The data behind #3 is string and just one letter (think: school grades). In this case, I am trying to find any cells that do not match a particular condition; i.e., not equal to a certain letter, such as "A", "B", "C", etc.

Peter_SSs · Sep 7, 2011

mirabeau said:
.. I generated a bit of test data (with about 1/3 blank cells out of about one million) with a test data code

Code:

With Range("A5:A1000000") .Cells = "=if(rand()>.33,int(rand()*50),"""")" .Value = .Value End With

and ran the code you provided and the code I provided three times each.
Peter_SSs code timed: 9.03secs, 9.04secs, 9.11secs
mirabeau code timed: 5.74secs, 5.75secs, 5.73secs
Am I wrong somewhere? but would you like to expand on your "... takes only about half as long", since this doesn't seem to be correct?

mirabeau

My original test data was just a mixture of blanks, text and integers like below, manually entered, then copied down to row 1,000,000

Excel Workbook

A

5

6

gd

7

dfg

8

9

g

10

fg

11

12

13

dfgs

14

2

15

6

16

0

Sheet4

I've just retested that and numerical values generated by your random number formula 4 times using each code. My results were, in seconds:
Peter_SSs code: 3.805, 3.758, 3.789, 3.699
mirabeau code: 7.254, 7.160, 7.051, 7.207

I don't have an explanation for the turn-around of the results between your tests and mine.

Do you have any ideas?

One thing I didn't mention is that I tested on Excel 2010 whereas the OP is using 2007. What were you using?

I have now been able to test on Excel 2007 and in a test on each set of data with each code I got:
Peter_SSs: 5.477, 6.254
mirabeau: 6.348, 6.645

Interestingly, though mine still tested slightly faster than yours, mine was considerably slower on 2007 v 2010 while yours was faster.

CaliKidd

Would be interested in your speed results.

However, given your confirmation that data is only in column A, this is a marginally faster (for me anyway

) version of my earlier code.

 Sub ColourAndCountBlanks_2() Dim rws As Long, c As Long, z As Long Const fr As Long = 5 Const lr As Long = 1000000 rws = lr - fr + 1 Application.ScreenUpdating = False With Cells(fr, "A").Resize(rws, 2) .Cells(1, 2).Value = 1 .Offset(, 1).Resize(, 1).DataSeries .Sort Key1:=.Cells(1, 1), _ Order1:=xlAscending, Header:=xlNo z = .Cells(1, 1).End(xlDown).Row c = lr - z If c > 0 Then Cells(z + 1, 1).Resize(c).Interior.ColorIndex = 3 End If .Sort Key1:=.Cells(1, 2), _ Order1:=xlAscending, Header:=xlNo .Offset(, 1).Resize(, 1).ClearContents End With Application.ScreenUpdating = True MsgBox "Count = " & c End Sub 

In relation to your other problems, this is slower than the 'blanks' and there may be faster ways, but try this for
1. Find cells with a specific value (e.g., 0 (zero))

 Sub ColourAndCount() Dim rws As Long, c As Long, z As Long, i As Long Dim rA As Range, rB As Range, rC As Range, rBC As Range, rABC As Range Dim b Const fr As Long = 5 Const lr As Long = 1000000 rws = lr - fr + 1 Set rA = Cells(fr, "A").Resize(rws) With rA Set rB = .Offset(, 1) Set rC = .Offset(, 2) Set rABC = .Resize(, 3) End With Set rBC = rB.Resize(, 2) b = rA.Value For i = 1 To rws '******************************* 'Cells = 0 Select Case b(i, 1) Case vbNullString b(i, 1) = "#" Case 0 b(i, 1) = vbNullString End Select '******************************* Next i Application.ScreenUpdating = False rB.Value = b rC.Cells(1).Value = 1 rC.DataSeries rABC.Sort Key1:=rB.Cells(1), Order1:=xlAscending, Header:=xlNo z = rB.Cells(1).End(xlDown).Row c = lr - z If c > 0 Then Cells(z + 1, rA.Column).Resize(c).Interior.ColorIndex = 3 End If rABC.Sort Key1:=rC.Cells(1), Order1:=xlAscending, Header:=xlNo rBC.ClearContents Application.ScreenUpdating = True MsgBox "Count = " & c End Sub 

Then for the other problems, replace the section between the '****** rows with the relevant section from below. If they don't do what you want, post back with more details.

'Cells with value > 1 Select Case Val(b(i, 1)) Case Is > 1 b(i, 1) = vbNullString Case 0 b(i, 1) = "#" End Select 'Cells not equal to A or B or C Select Case b(i, 1) Case "A", "B", "C" Case Else b(i, 1) = vbNullString End Select 'Numeric cells Select Case b(i, 1) <> vbNullString And IsNumeric(b(i, 1)) Case True b(i, 1) = vbNullString Case False b(i, 1) = "#" End Select 'Text cells Select Case IsNumeric(b(i, 1)) Case True b(i, 1) = "#" Case False b(i, 1) = vbNullString End Select

Peter_SSs · Sep 7, 2011

Actaully, not sure why I was using a text value.
Changing
b(i, 1) = "#"
to
b(i, 1) = 0
in the codes in my previous post saves approximately 1/3 to 1/2 second for me.

mirabeau · Sep 8, 2011

... mainly for Peter_SSs

Hi,

I did recheck that stuff on how long it takes using your suggested data (generated via the following code)

Code:

Sub pssstestdata()
Dim nul, c(), j&
Dim u&, e, arr
ReDim c(1 To 10 ^ 6 + 8, 1 To 1)
nul = vbNullString
arr = Array(nul, "gd", "dfg", nul, "g", "fg", _
        nul, nul, "dfgs", 2, 6, 0)
For j = 1 To 10 ^ 6 Step UBound(arr) + 1
    For Each e In arr
        u = u + 1
        c(u, 1) = e
    Next e
Next j
[a5].Resize(10 ^ 6 - 4) = c
End Sub

The results were essentially the same as in my Post#21. As would be expected, the specifics of the data (with about 1/3 blanks) made little difference difference to the respective rankings and the times.

Yes, it is interesting and remarkable that you and I should get pretty much opposite results from exactly the same data.

However, in this case, it's also good that any divergence can be easily and objectively assessed by any third party with an interest, because the requisite data is readily and immediately available.

I have Excel 2007, HP portable computer with I7 processor and 4gb ram. I don't have access to a usable version of Excel 2010.

mirabeau · Sep 8, 2011

hey Calikid,

You were also interested in highlighting specific values. Say all values of zero in a list about 1 million long.

There's a code in the previous post which will relatively quickly list Peter's suggested test data down to row 1miilion in ColA.

One in every 12 is a zero.

To highlight all the zeros in ColA, try the following code, which took under two seconds on my computer to do the job.

Code:

Sub hilitezeros() 
Dim t#
t = Timer
Dim e As Range, a As Range, ang As String
Dim stg, x&, k&, p&, nr&
Set e = Range("A1")
nr = e(Rows.Count).End(3).Row
Set a = Range(e, e(nr))
stg = 0

Do
x = Application.Match(stg, a, 0)
If IsError(x) Then Exit Do
k = k + x
ang = ang & ",A" & k
If Len(ang) > 245 Or k >= nr Then
    Range(Right(ang, Len(ang) - 1)).Interior.Color = vbGreen
    ang = vbNullString
End If
If k >= nr Then Exit Do
p = p + 1
Set a = Range(e(k + 1), e(nr))
Loop

MsgBox "Code took " & Format(Timer - t, "0.00 secs") & Chr(10) & _
    Chr(10) & "Count = " & p
Cells(Rows.Count, 1).End(3).Select
End Sub

Of course easily extended to any value or string, not just zero.

RoryA · Sep 8, 2011

FWIW, using 2007 on WinXP I ran both sets of code 3 times each on the sample data. Output:
Mirabeau:
Total: 25.13683
Average: 8.37893
Max: 10.14229

Peter:
Total: 25.59975
Average: 8.53323
Max: 9.02622

so both pretty much the same.

Peter_SSs · Sep 8, 2011

rorya said:
FWIW, using 2007 on WinXP I ran both sets of code 3 times each on the sample data. Output:
Mirabeau:
Total: 25.13683
Average: 8.37893
Max: 10.14229

Peter:
Total: 25.59975
Average: 8.53323
Max: 9.02622

so both pretty much the same.

Thanks for doing that Rory. I'm still struggling with how mirabeau & I could be getting such opposite results. Your results are really quite different again.

My tests were on Excel 2007 & 2010 (32 bit). OS is Win7 professional (64 bit) SP1. Don't know what it all means but processor is Intel(R) Core(TM) i3 CPU 540 @ 3.07GHz. 8 GB RAM.

Is There A Faster Way To Do This?

CaliKidd

Board Regular

mirabeau

Banned user

Excel Facts

CaliKidd

Board Regular

mirabeau

Banned user

CaliKidd

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Peter_SSs

MrExcel MVP, Moderator

mirabeau

Banned user

mirabeau

Banned user

RoryA

MrExcel MVP, Moderator

Peter_SSs

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Is There A Faster Way To Do This?

Board Regular

Banned user

Excel Facts

Board Regular

Banned user

Board Regular

MrExcel MVP, Moderator

MrExcel MVP, Moderator

Banned user

Banned user

MrExcel MVP, Moderator

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock