Select the first filtered cell then move onto the next filtered cell down

Question

I have an Excel spreadsheet that has contact details, for example:

    A                 B            C            D                    E
1   Select who you would to like to email:      * Drop down list *
2   Name:            Company:      Role:        Email Address1:      Email Address2:
3   Michael Jackson  Jackson 5     Singer       MJ@J5.com            Michael@J5.com
4   Brian May        Queen         Guitarist    BM@Queen.com         Brian@Queen.com
5   Kurt Cobain      Nirvana       Singer       KC@Nirvana.com       Kurt@Nirvana.com
6   Freddie Mercury  Queen         Singer       FM@Queen.co.uk       Freddie@Queen.com
7   Pat Smear        Nirvana       Guitarist    PS@Foo.com           Pat@Foo.com

A user selects an email address using the drop down list in D1 then runs a macro that gets the email addreses in that column.

The problem is when a user applies a filter, say all guitarists, it will select the first filtered row (C4) and then go to the next row rather than the next filtered row, so it would go to C5.

This is an adaption of the code:

Sub SendEmail()

Dim objOutlook As Object
Dim objMail As Object
Dim RowsCount As Integer
Dim Index As Integer
Dim Recipients As String
Dim Category As String
Dim CellReference As Integer

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

RowsCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1

Category = Range("D1")
Dim RowLimit As String
If Category = "Email Address1" Then
    CellReference = 4
ElseIf Category = "Email Address2" Then
    CellReference = 5
End If

Index = 0
While Index < RowsCount
    Set EmailAdrs = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, CellReference).Offset(0 + Index, 0)
    Recipients = Recipients & EmailAdrs.Value & ";"
    Index = Index + 1
Wend

 With objMail
    .To = Recipients
    .Subject = "This is the subject"
    .Display
End With

Set objOutlook = Nothing
Set objMail = Nothing

End Sub

I tried looping through rows that are hidden:

While Index < RowsCount
   Do While Rows(ActiveCell.Row).Hidden = True
       'ActiveCell.Offset(1).Select
       Set EmailAdrs = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, CellReference).Offset(0 + Index, 0)
        Recipients = Recipients & EmailAdrs.Value & ";"
        Index = Index + 1
        ActiveCell = ActiveCell.Offset(0 + Index, 0).Select
    Loop
Wend

I tried going through only cells that are visible.

I tried ideas from VBA Go to the next filtered cell:

If ActiveSheet.FilterMode = True Then
    With ActiveSheet.AutoFilter.Range
        For Each a In .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible).Areas
            Recipients = Recipients & a(1, CellReference) & ";"
        Next
    End With
    MsgBox Replace(Recipients, ";;", vbNullString)
End If

And:

Dim Rng As Range
If Category = Range("S2") Then
    CellReference = 10
    'Set your range
    Set Rng = Range("A1:B2")
ElseIf Category = Range("S3") Then
    CellReference = 14
    'Set your range
    Set Rng = Range("C1:D2")
ElseIf Category = Range("S4") Then
    CellReference = 18
    'Set your range
    Set Rng = Range("F1:G2")
ElseIf Category = Range("S5") Then
    CellReference = 16
    'Set your range
    Set Rng = Range("H1:J2")
End If

For Each mCell In ThisWorkbook.Sheets("YourSheetName").Range(Rng).SpecialCells(xlCellTypeVisible)
    'Get cell address
    mAddr = mCell.Address
    'Get the address of the cell on the column you need
    NewCellAddr = mCell.Offset(0, ColumnsOffset).Address
    'Do everything you need
Next mCell

mielk · Accepted Answer · 2017-03-30T12:52:40.237

Try this code:

Sub SendEmail()
    Dim objOutlook As Object
    Dim objMail As Object
    'Dim RowsCount As Integer
    'Dim Index As Integer
    Dim Recipients As String
    Dim Category As String
    Dim CellReference As Integer
    Dim RowLimit As String
    'New variables.
    Dim firstRow As Long
    Dim lastRow As Long
    Dim cell As Excel.Range
    Dim row As Long



    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)


    Category = Range("D1")
    If Category = "Email Address1" Then
        CellReference = 4
    ElseIf Category = "Email Address2" Then
        CellReference = 5
    End If



    With ActiveSheet

        'Find the first and last index of the visible range.
        firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).row
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row


        'Iterate through all the rows between [firstRow] and [lastRow] established before.
        'Some of those rows are hidden, but we will check it inside this loop.
        For row = firstRow To lastRow

            Set cell = .Cells(row, CellReference)

            'We are checking here if this row is hidden or visible.
            'Note that we cannot check the value of property Hidden of a single cell,
            'since it will generate Run-time error '1004' because a single cell cannot be
            'hidden/visible - only a whole row/column can be hidden/visible.
            'That is why we need to refer to its .EntireRow property first and after that we
            'can check its .Hidden property.
            If Not cell.EntireRow.Hidden Then

                'If the row where [cell] is placed is not hidden, we append the value of [cell]
                'to variable Recipients.
                Recipients = Recipients & cell.Value & ";"
            End If

        Next row

    End With


    With objMail
        .To = Recipients
        .Subject = "This is the subject"
        .Display
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing

End Sub

That works perfectly! Thank you! I appreciate that you've spent some time writing that code, but would you mind explaining it for me so that I can fully understand what's going on — Ben Smith, Jul 24 '15 at 13:22
@BenSmith I have added some additional comments to this code for better understanding. If you still have further questions let me know in comments. — mielk, Jul 24 '15 at 13:42
I realize, for huge sheets (over 10.000 rows), the for loop is very time consuming. Do you know about an efficient alternative for this? — Brethlosze, Apr 25 '19 at 06:37

Michael S Priz · Answer 2 · 2015-07-24T13:51:17.713

I believe the Hidden property of a range is what you want. The following code worked for me:

Dim row As Range
For Each row In Range("MyTable").Rows
    If not row.EntireRow.Hidden Then
        ''' DO STUFF '''
    End If
Next

I have always found that using a For Each loop is a much cleaner way to iterate through data in an excel sheet. "MyTable" was the name I gave to the range of interest but if you prefer you can just enter a the limits of the range like Range("A1:D4"). Though I think it is a better practice to use named ranges as it makes your code more readable.

EDIT: To address your comment...

If you insert a row into the middle of a named range the limits of the range automatically expand. Though if your table is going to be the only data in the worksheet you can also use the UsedRange property of a worksheet object. For instance:

Dim row As Range
For Each row In Worksheets("MySheet").UsedRange.Rows
    If not row.EntireRow.Hidden Then
        ''' DO STUFF '''
    End If
Next

If all you have is the first row of the table you can expand this range to the full table using:

dim FirstRow as Range
dim LastRow as Range
dim myTable as Range
set FirstRow = Range("A1:B1")
set LastRow = FirstRow.End(xlDown)
set myTable = Range(FirstRow, LastRow)

And then use the same For Each loop as before. Hope this helps!

Please note though that the range may change, one day there might be 150 rows and another there could 168 rows, so it might go up or down; would your code still work? — Ben Smith, Jul 24 '15 at 13:11
Refer to my edit for more verbosity. To summarize either use `UsedRange` or expand a single row to the full data set using the `End` method of a `Range` object. — Michael S Priz, Jul 24 '15 at 13:38

score 0 · Answer 3 · answered Apr 25 '19 at 07:11

For any interested in this solution, i realized that it is much more faster to test the logic of the filter in the cell value, instead of checking if the filter has the column hidden or not (in sheets with more than 10.000 rows), hence not requiring to select an entire row each time, just a single cell.

Of course, you need to know beforehand the expression for the filter, which is not dealt in this code.

For example if the filter test values less than 0.5, it is better to try:

Range("U1").Select 'The column where the filter is being applied
ActiveCell.Offset(1, 0).Select
Do Until CDbl(ActiveCell.Formula) < 0.5 'The condition applied in the filter
    ActiveCell.Offset(1, 0).Select
Loop

Select the first filtered cell then move onto the next filtered cell down

3 Answers3

Linked