Solved

In MS Excel VBA, define a range of only those cells in a column that contain the value False

Posted on 2016-09-02
24
31 Views
Last Modified: 2016-09-27
I have a sheet with data in columns A:H with ~16000 rows
H:H contains boolean values, either true or false.
All but ~100 of the values are True and those rows are of no interest.
I need to process the rows where cell H:H is false.

Traversing the full column from top to bottom is sloooooooooooooow.
Is there an efficent way to define a range of those rows where H:H = false so that my code doesn't have to deal with the values of no interest at all?

In the UI, it would be the equivalent of applying a filter, and then moving down each filtered row and executing a macro.
How do you accomplish something similar in VBA?
0
Comment
Question by:Nick67
  • 13
  • 8
  • 3
24 Comments
 
LVL 15

Expert Comment

by:WalkaboutTigger
Comment Utility
If Range("H1") = False then...

Open in new window


or

Dim i as Long
For i = 1 to Rows.Count
  If Cells(i, 8).Value = False Then
    Cells(i, 8).Font.Color = vbRed
  End If
Next i

Open in new window

would loop through all the values in column H whose values are False and set the font color to red.
0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
I don't understand

I presently have
Dim LastRow As Long
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For x = 3 To LastRow
    Select Case True
        Case xlsht.Cells(x, "h") = True
            GoTo alreadygood
        Case xlsht.Cells(x, "b") = ""
            GoTo alreadygood
        Case IsNumeric(Left(xlsht.Cells(x, "b"), 5)) = False
            GoTo alreadygood
        Case IsDate(xlsht.Cells(x, "f")) = True ' already returned
            GoTo alreadygood
        Case Else
            'code that processes the 100 or so rows that need it
    End Select
alreadygood:
Next x

Open in new window


But this is very slow as LastRow = ~16000
0
 
LVL 15

Expert Comment

by:WalkaboutTigger
Comment Utility
So you're testing three things in every row prior to determining the 100 or so rows that need work - in your original post, you seemed to indicate that all BUT 100 rows needed action taken.
If the value in H being false indicates a row needing work, why not look for just that?

Dim LastRow As Long
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For x = 3 To LastRow
    Select Case True
        Case xlsht.Cells(x, "h") = False
            'code that processes the 100 or so rows that need it
        Case xlsht.Cells(x, "h") = True
            GoTo alreadygood
        Case xlsht.Cells(x, "b") = ""
            GoTo alreadygood
        Case IsNumeric(Left(xlsht.Cells(x, "b"), 5)) = False
            GoTo alreadygood
        Case IsDate(xlsht.Cells(x, "f")) = True ' already returned
            GoTo alreadygood
        Case Else
            'code that processes the 100 or so rows that need it
    End Select
alreadygood:
Next x

Open in new window


This will run faster than checking every row value 3 times first.
0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
Sorry:
All but ~100 of the values are True and those rows are of no interest
meant that the True values are of no interest.
It's a Select Case True.
The Cases are evaluated in order so since 15,900 are True, most of the loop evaluates for that one condition, finds it true and moves on.

But that means the loop goes through all 16000 rows -- which is not efficient.
Is there a way to exclude all the H:H where they are True?
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
Please try something like this.....
Dim Rng As Range, Cell As Range
Dim LastRow As Long
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'H2 in the following line assumes that Row2 is header row
With Range("H2:H" & LastRow)
   .AutoFilter field:=1, Criteria1:=False
   On Error Resume Next
   Set Rng = Range("H3:H" & LastRow).SpecialCells(xlCellTypeVisible)
   If Not Rng Is Nothing Then
      For Each Cell In Rng
         'Do whatever you like to do with the False Cells here
      Next Cell
   End If
   .AutoFilter
End With

Open in new window

0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
@sktneer
Thank you.
That looks like it could be a winner.
I will test it.
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
You're welcome Nick!
Sure, test it at your end.
0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
@sktneer
No, no winner there either.
It works but is very slow.
Maybe I misunderstand the mechanism but:

Set Rng = Range("H2:H" & LastRow).SpecialCells(xlCellTypeVisible)
'so that's h2:h16000
If Not Rng Is Nothing Then
   For Each myCell In Rng
       'this appears that is also going through all 16000 of them
        'Do whatever you like to do with the False Cells here
        'for testing, throw something in column I
        Cells(myCell.Row, "i").Value = "good"
   Next myCell
End If

It SEEMS faster than

Range("H1").Select
Dim x As Integer
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Do Until ActiveCell.Row = LastRow
    Cells.Find(What:="false", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveSheet.Cells(ActiveCell.Row, "i").Value = "good"
Loop

because Find() is very expensive.
Or am I missing something?
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
Set Rng = Range("H3:H" & LastRow).SpecialCells(xlCellTypeVisible) will be the range of cells which have only False in Column H after applying the AutoFilter.

Debug the code by pressing F8 key and see if the filter is applied correctly.

Moreover if you want to set the values of column I to Good where there are False in column H, you may try something like this instead of looping through each visible cell in column H.
Dim Rng As Range, Cell As Range
Dim LastRow As Long
Set xlsht = ActiveSheet
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'H2 in the following line assumes that Row2 is header row
With Range("H2:H" & LastRow)
   .AutoFilter field:=1, Criteria1:=False
   On Error Resume Next
   Set Rng = Range("H3:H" & LastRow).SpecialCells(xlCellTypeVisible)
   If Not Rng Is Nothing Then
      Rng.Offset(0, 1).Value = "Good"
   End If
   .AutoFilter
End With
End Sub

Open in new window

0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
So I did miss something
Set Rng = Range("H2:H" & LastRow).SpecialCells(xlCellTypeVisible)

Debug the code by pressing F8 key and see if the filter is applied correctly.
I've set breakpoints along the way.
At first, no cells were in the filter.
I have that sorted.

In production, the code will actually be automation run from MS Access, and there are checks against database tables, and data operations that need to occur for each cell in the filtered range.

Thank you for clarifying.
I'll keep testing now that I understand what I have and that it is likely to be as good as it gets.
0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
It works, and I have flanged it into production but it is still not as fast as I would like.
Would using a DataRange improve performance?
https://blogs.office.com/2008/10/03/what-is-the-fastest-way-to-scan-a-large-range-in-excel/

Is that applicable here?
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
Hi Nick,

It depends on what calculation is being performed in col. I for all the False instances if found in col. H.
As I stated in Post ID: 41786687 that if your intention is to replace the content of col. I for all the False instances in col. H, the proposed code in the same post would do it at once.

How many rows are actually there on the sheet and do you have formulas on the sheet also?

Also you may try the below technique to see if that improves the performance issue.
Sub YourCode()
'Variable declaration

With Application
   .Calculation = xlCalculationManual
   .EnableEvents = False
   .ScreenUpdating = True
End With

'your code goes here
'
'
'
'
With Application
   .Calculation = xlCalculationAutomatic
   .EnableEvents = True
   .ScreenUpdating = True
End With
End Sub

Open in new window

0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 28

Assisted Solution

by:Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj) earned 500 total points
Comment Utility
I just used the array technique and ran the code for 200000 rows of data and it ran instantly i.e. in less than 1 second.
What the following code does is, it changes the value of a cell in col. I to "Good" if a False is found in corresponding cells in col. H otherwise it retains the existing values in col. I.

See if you can adopt this into your own code.
Sub ArrayTechnique()
Dim xlsht As Worksheet
Dim Rng As Range, Cell As Range
Dim LastRow As Long, i As Long
Dim x, y()
Dim TimeTaken As Date

TimeTaken = Now
Set xlsht = ActiveSheet
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
x = xlsht.Range("H3:I" & LastRow).Value
ReDim y(1 To LastRow, 1 To 1)
For i = 1 To UBound(x, 1)
   If x(i, 1) = False Then
      y(i, 1) = "Good"   'Getting new value for col. I
   Else
      y(i, 1) = x(i, 2)  'retaining the old value of col. I
   End If
Next i
Range("I3").Resize(UBound(y)).Value = y
MsgBox "Time taken : " & Format(Now - TimeTaken, "hh:mm:ss")
End Sub

Open in new window

0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
Instantly is good.
Was that technique a new idea  to you and a surprise?
I think I grasp the concept now.
You used a variant to hold a input range and an array to hold the output -- and processed the variant and not the Excel range.

I'll test it, but instantly sounds like a winner.
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
None of the techniques is a new idea or a surprise but you don't know which technique will be best suited unless you know what has to be done or what calculations have to be performed. And I am still unaware of that as you haven't told me yet. :)
Arrays are comparatively faster when you have to manipulate a large data set.

But again if your intention is just to replace the values in col. I depending on a particular value in col. H and you have 17000 odd rows of data on the sheet, the solution posted in Post ID: 41786687 will do the trick and of course array technique will also do the job and comparatively faster.
0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
And I am still unaware of that as you haven't told me yet. :)

I had discussed that in general, above.
In production, the code will actually be automation run from MS Access, and there are checks against database tables, and data operations [primarily in MS Access]that need to occur for each cell in the filtered range.
Excel is a bit of sideshow, used primarily for printing and a bit of drag-and-drop re-arrangeability.

In one spot
CountIf the number of TRUE in column H as 'y'
For rows where cell H is not TRUE
    If cell F is a date, set cell H = TRUE, increment y, and move on
    else fire up a DAO recordset using the value in cell B
        if there is data, check the field that has the data correlating to cell F, and set cell F to that data and cell H to true, and increment y
        If the recordset has no data, or not the right type of data, set cell H to false.
    If cell C is a date, increment y
After that is done, If y equals the count of records in a certain table, exit.

Elsewhere:
For rows where cell H is not TRUE
    Check if cell B is blank, if so, move on
    Check if the left five characters of cell B are numeric, if not, move on
    Check if cell F is a date, if so, move on.
    If we got to this point,
         do a FindFirst in an already generated DAO recordset with the value in cell B
        Add a new record in another recordset using one value from the recordset above and cells B, D, and E

There's not a lot going on in Excel. it is being used as a vehicle for MS Access ETL code.

The point of H:H is just as a flag to tell the code that there is nothing needing to be processed in those rows, to make the code faster.
0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
That didn't quite play nicely
Range("I3").Resize(UBound(y)).Value = y
didn't write the values.

This worked, though
Dim xlsht As Worksheet
Dim Rng As Range, myCell As Range
Dim LastRow As Long, i As Long
Dim x, y()
Dim TimeTaken As Date

TimeTaken = Now
Set xlsht = ActiveSheet
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
x = xlsht.Range("H2:I" & LastRow).Value
ReDim y(1 To LastRow, 1 To 1)
For i = 1 To UBound(x, 1)
   If x(i, 1) = False Then
      y(i, 1) = "Good"   'Getting new value for col. I
   Else
      y(i, 1) = x(i, 2)  'retaining the old value of col. I
   End If
Next i
xlsht.Range("I2:I" & LastRow).Value = y
MsgBox "Time taken : " & Format(Now - TimeTaken, "hh:mm:ss")

Open in new window


Now to adapt it for production and test it!
0
 
LVL 15

Expert Comment

by:WalkaboutTigger
Comment Utility
I would suggest you write your test cases out first, just to ensure you don't overlook something.
0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
I would suggest you write your test cases out first
I don't understand
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
Range("I3").Resize(UBound(y)).Value = y and  xlsht.Range("I2:I" & LastRow).Value = y are same except in the first syntax the range is not qualified with the sheet reference i.e. xlsht.
So xlsht.Range("I3").Resize(UBound(y)).Value = y should work.
0
 
LVL 26

Accepted Solution

by:
Nick67 earned 0 total points
Comment Utility
It turns out, given that this is automation from MS Access, that this operation
xlsht.Range("I3").Resize(UBound(y)).Value = y
is very sloooooow, too.

I am testing a hybrid at the moment, where the data from Excel is read into a variant
x = xlsht.Range("H2:I" & LastRow).Value
and used for comparisons and logical checks, but data is written back directly to the sheet.

That seems to be the best of both worlds.
I'll keep you posted.
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
I know you are smart enough to tweak it as per your requirement. :)
0
 
LVL 26

Author Comment

by:Nick67
Comment Utility
Thank you both.
I appreciated the help.

Nick67
0
 
LVL 26

Author Closing Comment

by:Nick67
Comment Utility
As it turns out, since the automation is running from MS Access, a hybrid solution where the Excel range is read into a variant and used for calculations, but changes to Excel were done cell-by-cell was the best solution.

Whatever database driver is in use to attempt to write the variant to the sheet was very slow.
If the solution was strcitly in Excel, reading to a variant, altering it, and writing it back to the sheet performs very, very fast -- but not when Access is the source of the automation.  The writing back is then painfully slow.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now