VBA Go to the next filtered cell

Question

I am currently using the following 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)

    If ActiveSheet.FilterMode = True Then
        RowsCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
    ElseIf ActiveSheet.FilterMode = False Then
        RowsCount = Application.CountA(Range("A2:A" & Rows.Count)) - 1
    End If

    ' In Range("I1") there is the job category the user wants to email
    Category = Range("I1")
    If Category = Range("S2") Then
        ' CellReference is the amount of columns to the right of column A, ie Column A is 0 so CellReference below is J - which is the column location of the email address according to that category
        CellReference = 10
    ElseIf Category = Range("S3") Then
        CellReference = 14
    ElseIf Category = Range("S4") Then
        CellReference = 18
    ElseIf Category = Range("S5") Then
         CellReference = 16
    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

This code checks to see if a filter has been applied and counts the amounts of rows if there is one or isn't one, it then checks to see who should be emailed (the 'Category' which is in I1 is the job position of different individuals) and then gets the email addresses of those required, the issue I'm having is say I have the following data (this is just an example of what I want to do):

Column A         Column B             Column C
Smith            Male                 [e-mail]
Jones            Male                 [e-mail]
Smith            Female               [e-mail]
Jones            Female               [e-mail]
Smith            Male                 [e-mail]
Smith            Female               [e-mail]
Smith            Female               [e-mail]
Jones            Female               [e-mail]

And I filter on Jones in column A and Female in Column B to get two rows returned, rather than getting the email addresses [e-mail] and [e-mail] it will get the email addresses [e-mail] and [e-mail] because it finds the first row with the filter applied then goes to the next cell disregarding the filter.

Is there a way I can fix this so that it gets the filtered cells?

It is important to point out that the filter may not always be the same, so it won't always be both Column A and Column B, it might just be Column A or just Column B.

Answer 1

You can use

1) To select a range: (Of course you can use a formula instead of a fixed range)

Dim Rng As Range
If Category = Range("S2") Then
    ' CellReference is the amount of columns to the right of column A, ie Column A is 0 so CellReference below is J - which is the column location of the email address according to that category
    CellReference = 10
    'Set your range
    Set Rng = [Insert here your criteria to set the range when CellReference = 10]

ElseIf Category = Range("S3") Then
    CellReference = 14
    'Set your range
    Set Rng = [Insert here your criteria to set the range when CellReference = 14]
ElseIf Category = Range("S4") Then
    CellReference = 18
    'Set your range
    Set Rng = [Insert here your criteria to set the range when CellReference = 18]
ElseIf Category = Range("S5") Then
     CellReference = 16
    'Set your range
    Set Rng = [Insert here your criteria to set the range when CellReference = 16]
End If

(Consider using a Select Case instead of ElseIf) And then loop the range

'You need to replace YourSheetName with the real name of your sheet
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

mCell is an Object variable that contains a lot of informations on the cells that it represents.

So, if mCell is the A1 Cell containing "Hello World":

mCell.Address will be "$A$1"
mCell.Value will be "Hello World"
mCell.Offset(0, 2).Address will be "$C$1"

You can also get and/or set a lot of other data:

mCell.NumberFormat
mCell.RowHeight
mCell.Formula

Have a look at local variables to see all you can get/set for mCell

Answer 2

Replace the bottom section of your code with this:

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