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 number of lines, if it is one or more, then it checks who should be sent by email (the “Category” located at I1this place of work of different people), and then receives the addresses of the email that is required, the problem I am facing says that 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]

Jones A Female B, , [e-mail] [e-mail] [e-mail] [e-mail], , , .

, ?

, , A, B, A B.

Answer 1

1) : (, )

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

( Select Case ElseIf).

'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 - Object, , .

, mCell A1, "Hello World":

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

/ :

mCell.NumberFormat
mCell.RowHeight
mCell.Formula

, , / mCell

Answer 2

:

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