Need VBA to Highlight Rows with all N's

S

Stephen_IV

Well-known Member
Joined
Mar 17, 2003
Messages
1,168
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Good morning,

I have over 300,000 rows of data in Columns A-F. The rows have either N or Y in them. What I need to do is to highlight all rows that have just N's in them. I do not want a formula and Code will help! Thanks in advance.
<style type="text/css">
table.tableizer-table {
font-size: 12px;
border: 1px solid #CCC ;
font-family: Arial, Helvetica, sans-serif;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #CCC ;
}
.tableizer-table th {
background-color: #104E8B ;
color: #FFF ;
font-weight: bold;
}
</style>
<table class="tableizer-table">
<thead><tr class="tableizer-firstrow"><th>N</th><th>N</th><th>N</th><th>N</th><th>N</th><th>N</th></tr></thead><tbody>
<tr><td>Y</td><td>N</td><td>N</td><td>N</td><td>N</td><td>Y</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>Y</td><td>N</td><td>N</td><td>N</td><td>N</td><td>N</td></tr>
<tr><td>Y</td><td>N</td><td>N</td><td>N</td><td>N</td><td>Y</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>N</td><td>N</td><td>Y</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>Y</td><td>N</td><td>N</td><td>N</td><td>N</td><td>Y</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>N</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>Y</td><td>N</td><td>N</td></tr>
<tr><td>N</td><td>N</td><td>N</td><td>N</td><td>N</td><td>N</td></tr>
</tbody></table>
 
Sort by date Sort by votes
That's true Mark. And thanks again for your help Mark. I'm sure there are others who can always write scripts better then mine.
MARK858 said:
I think you will find M.A.I.T. is referring to looping over a range not an array.
Click to expand...
 
Upvote 0

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sure, so that suggests faster to loop over an array than a range object, but in reference to Rick's comment about removing a line of (un-needed) code, with the reduced execution time, wouldn't looping over an array and applying a single filter to highlight the required rows be faster?
 
Last edited:
Upvote 0
@Rick Rothstein, this works (slight change to code in #13 and assuming there is a header row) for 20 rows of varying "Y" and "N" values with correct rows highlighted:
Code: 
Sub Auto_Filter()
    
    Dim LR              As Long
    Dim x               As Long
    Dim i               As Long
    Dim arr()           As Variant
    Dim arrPattern(1 To 2)    As Variant
    Dim strPattern      As String
    Dim strRow          As String
    Const delim         As String = "|"
    
    arrPattern(1) = "NNNNNN"
    arrPattern(2) = "YNNNNN"
    
    For x = LBound(arrPattern) To UBound(arrPattern)
        strPattern = arrPattern(x) & delim & strPattern
    Next x
    strPattern = Trim$(Left$(strPattern, Len(strPattern) - 1))
    
    Application.ScreenUpdating = False
        
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        .Cells.Interior.ColorIndex = xlNone
        LR = .Cells(.Rows.Count, 1).End(xlUp).row
        arr = .Cells(1, 1).Resize(LR, 7).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            strRow = Join(Application.Index(arr, x, 0), "")
            If InStr(strPattern, strRow) * Len(strRow) > 0 Then arr(x, UBound(arr, 2)) = True
        Next x
        
        With .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2))
            .Value = arr
            .AutoFilter Field:=UBound(arr, 2), Criteria1:=True
            .Offset(1).Resize(UBound(arr, 1) - 1, UBound(arr, 2) - 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
        End With

        .AutoFilterMode = False
        .Cells(1, UBound(arr, 2)).Resize(UBound(arr, 1)).ClearContents
    End With
    
    Application.ScreenUpdating = True
    Erase arr
    Erase arrPattern
       
End Sub
 
Last edited:
Upvote 0
JackDanIce said:
@Rick Rothstein, this works (slight change to code in #13 and assuming there is a header row) for 20 rows of varying "Y" and "N" values with correct rows highlighted:
Click to expand...
You only tested for a small sampling... your code doesn't work for 300,000 rows (actually, for a lot less rows than that). The reason for the Type Mismatch error I keep getting appears to be because of a built-in limitation in the Application.Index function... if won't work for more than 60,000 (or maybe it's 64,000, not sure) rows of data in the array, so 300,000 rows is way too many. Even if it did work for that many rows, it would take what seemed like forever to complete. I limited the array to 5000 rows and your code took just under 62 seconds to complete.
 
Upvote 0
Thank you, didn't know about that yes because didn't test for 300k rows!

Application.Index(arr, x, o) should be an array of row size 1, all 6 columns i.e. Slicing each row of the array and then combing it into a string to compare against the combined patterns. Seems odd it works upto a limit since the size is constant for each iteration (1 x 6)

So for this, filters are more efficient that loops, good to know, thanks all
 
Last edited:
Upvote 0
JackDanIce said:
Application.Index(arr, x, o) should be an array of row size 1
Click to expand...
It is, but the problem is that Application.Index cannot handle an array with too many rows in it (probably a limit in the maximum amount of memory allocated for the array to be stored in).

Actually, a quick (and I mean quick) search seems to indicate that the problem is with the WorksheetFunction method (which is what Application.Index apparently calls behind the scenes)... the consensus seems to be that your cannot pass an array larger than 65536 rows (elements?) to any WorksheetFunction function which, of course, includes the Index function.
 
Upvote 0
@Rick Rothstein, this link confirms what you found regarding limit at 65,536 rows: https://stackoverflow.com/questions/175170/how-do-i-slice-an-array-in-excel-vba
An oversight by Microsoft when the row numbers, file formats etc changed from 2003XL to current?

Using an inner loop to build each row string for comparison works, though suspect the earlier filter code is faster:
Code: 
Sub Auto_Filter()
    
    Dim LR              As Long
    Dim x               As Long
    Dim i               As Long
    Dim arr()           As Variant
    Dim arrPattern(1 To 2)    As Variant
    Dim strPattern      As String
    Dim strRow          As String
    Const delim         As String = "|"
    
    arrPattern(1) = "NNNNNN"
    arrPattern(2) = "YNNNNN"
    
    For x = LBound(arrPattern) To UBound(arrPattern)
        strPattern = arrPattern(x) & delim & strPattern
    Next x
    strPattern = Trim$(Left$(strPattern, Len(strPattern) - 1))
    
    Application.ScreenUpdating = False
        
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        .Cells.Interior.ColorIndex = xlNone
        LR = .Cells(.Rows.Count, 1).End(xlUp).row
        arr = .Cells(1, 1).Resize(LR, 7).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            For i = LBound(arr, 2) To UBound(arr, 2) - 1
                strRow = strRow & arr(x, i)
            Next i
            
            If InStr(strPattern, strRow) * Len(strRow) > 0 Then
                arr(x, UBound(arr, 2)) = True
            End If
            strRow = vbNullString
        Next x
        
        With .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2))
            .Value = arr
            .AutoFilter Field:=UBound(arr, 2), Criteria1:=True
            .Offset(1).Resize(UBound(arr, 1) - 1, UBound(arr, 2) - 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
        End With


        .AutoFilterMode = False
        .Cells(1, UBound(arr, 2)).Resize(UBound(arr, 1)).ClearContents
    End With


    Application.ScreenUpdating = True
    Erase arr
    Erase arrPattern
       
End Sub
 
Last edited:
Upvote 0
JackDanIce said:
Using an inner loop to build each row string for comparison works, though suspect the earlier filter code is faster:
Code: 
Sub Auto_Filter()
    
    Dim LR              As Long
    Dim x               As Long
    Dim i               As Long
    Dim arr()           As Variant
    Dim arrPattern(1 To 2)    As Variant
    Dim strPattern      As String
    Dim strRow          As String
    Const delim         As String = "|"
    
    arrPattern(1) = "NNNNNN"
    arrPattern(2) = "YNNNNN"
    
    For x = LBound(arrPattern) To UBound(arrPattern)
        strPattern = arrPattern(x) & delim & strPattern
    Next x
    strPattern = Trim$(Left$(strPattern, Len(strPattern) - 1))
    
    Application.ScreenUpdating = False
        
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        .Cells.Interior.ColorIndex = xlNone
        LR = .Cells(.Rows.Count, 1).End(xlUp).row
        arr = .Cells(1, 1).Resize(LR, 7).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            For i = LBound(arr, 2) To UBound(arr, 2) - 1
                strRow = strRow & arr(x, i)
            Next i
            
            If InStr(strPattern, strRow) * Len(strRow) > 0 Then
                arr(x, UBound(arr, 2)) = True
            End If
            strRow = vbNullString
        Next x
        
        With .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2))
            .Value = arr
            .AutoFilter Field:=UBound(arr, 2), Criteria1:=True
            .Offset(1).Resize(UBound(arr, 1) - 1, UBound(arr, 2) - 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
        End With


        .AutoFilterMode = False
        .Cells(1, UBound(arr, 2)).Resize(UBound(arr, 1)).ClearContents
    End With


    Application.ScreenUpdating = True
    Erase arr
    Erase arrPattern
       
End Sub
Click to expand...
Your code is slower, but not by that much. The timing difference for the earlier AutoFilter method is probably do to background processes occurring on my computer. Now, I get the earlier AutoFilter method executing in 4.8 seconds... your code executed in 6.7 seconds.
 
Upvote 0
Tried to change my code to process the array in "chunks" of 65,000 rows which stepping through till about x = 20 works fine, but leaving it to run takes ages and I can't seem to pause or break the macro, the debug.print statement doesn't appear to print x at intervals of 10,000 either:
Code: 
Sub Auto_Filter()
    
    'Dim LR                  As Long
    Dim x                   As Long
    Dim i                   As Long
    Dim strRow              As String
    Dim arr()               As Variant
    
    Dim arrPattern(1 To 2)  As Variant
    Dim strPattern          As String
    
    Const delim             As String = "|"
    Const ROWLIMIT      As Long = 65000
    
    arrPattern(1) = "NNNNNN"
    arrPattern(2) = "YNNNNN"
    
    For x = LBound(arrPattern) To UBound(arrPattern)
        strPattern = arrPattern(x) & delim & strPattern
    Next x
    strPattern = Trim$(Left$(strPattern, Len(strPattern) - 1))
    
    Application.ScreenUpdating = False
        
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        .Cells.Interior.ColorIndex = xlNone
        'LR = .Cells(.Rows.Count, 1).End(xlUp).row
        
        For i = 1 To 300000 Step ROWLIMIT
            arr = .Cells(i, 1).Resize(ROWLIMIT, 7).Value
            For x = LBound(arr, 1) To UBound(arr, 1)
                'For i = LBound(arr, 2) To UBound(arr, 2) - 1
                '    strRow = strRow & arr(x, i)
                'Next i
                strRow = Join(Application.Index(arr, x, 0), "")
                If InStr(strPattern, strRow) * Len(strRow) > 0 Then arr(x, UBound(arr, 2)) = True
                If x Mod 10000 = 0 Then Debug.Print x
            Next x
        Next i
        
        With .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2))
            .Value = arr
            .AutoFilter Field:=UBound(arr, 2), Criteria1:=True
            .Offset(1).Resize(UBound(arr, 1) - 1, UBound(arr, 2) - 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
        End With


        .AutoFilterMode = False
        .Cells(1, UBound(arr, 2)).Resize(UBound(arr, 1)).ClearContents
    End With


    Application.ScreenUpdating = True
    Erase arr
    Erase arrPattern
       
End Sub
It does seem like for testing a small number of patterns, filters are faster than array-looping if the row size is > 65,536, appreciate the replies, comments and code suggestions, thank you @Rick and to know about Application.Index / Worksheet function limits with array sizes.
 
Last edited:
Upvote 0
At the end of the day I think you should use my script. With some help from Mark.
Code: 
Sub Auto_Filter_New()
'Modified 9-3-17 5:00 PM EDT
Application.ScreenUpdating = False
If AutoFilter = True Then AutoFilter = False
    With Range("A1:F" & Cells(Rows.Count, "A").End(xlUp).Row)
        .Cells.Interior.ColorIndex = xlNone
        .AutoFilter Field:=2, Criteria1:="N"
        .AutoFilter Field:=3, Criteria1:="N"
        .AutoFilter Field:=4, Criteria1:="N"
        .AutoFilter Field:=5, Criteria1:="N"
        .AutoFilter Field:=6, Criteria1:="N"
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 3
       .AutoFilter
    End With
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA to identify matches in multiple columns and return values from matching rows in a different column, to another worksheet.
Replies
4
Views
1K
cjctmo
C
E
  • Question
Adding a custom message.
Replies
1
Views
444
Micron
M
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C
V
  • Solved
How to put a space in this table in VBA?
Replies
1
Views
328
VBAEXCELNew
V
E
  • Question
Query in excel to Outlook mail take rows with name until next name
Replies
0
Views
356
esben
E

Forum statistics

Threads
1,215,340
Messages
6,124,386
Members
449,155
Latest member
ravioli44

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top