small logic is missing (auto mail)

Hi,

First of all, Sorry for my bad english.

With my basic knowledge I created vba code for sending auto mails. But in the code first if condition is not executing. i tried in different ways. but all are went in vain. Pls help me.


Criteria:
1) if employee status is "Resigned" ("Status" column mentioned in "Master" sheet) then mail should not go to that person.

2) if employee status is "Working" and there is no individual attachment for him, then mail should go with remaining all attachments (attachment file path's are mentioned in 'column F' in "Emp Information" Sheet).

3) if employee status is "Working" and there is individual attachment, then mail should go with remaining all attachments (attachment file paths mentioned in each individual cell in 'Column F' in "Emp Information" sheet) including individual attachment (attachment file path mentioned in each individual cell in 'Column F' in "Emp Information" sheet).

Example:

1)Employee's A1,A5,A9,A10,A15 are resigned. So they should not get email.
2) Employee A3 is Working and there is no file to attach for them (Column F in "Emp information" sheet). then Mail should go with remaining all attachments in column G in "Emp information" Sheet ("Covering letter.txt","1.txt")
3) for employees A2,A4,A6,A7,A8,A9,A11,A13,A14 , mail should go with all attachments (individual & remaining files)

I hope criteria's are clear.


Code is perfect except one error. if there are more than one resigned employees (A9 and A10 employees details are in a row in "Emp information" Sheet. They both are resigned. ) details came one by one, then error occurs.

i can't understand where the mistake was occurred in my code. Pls help me

Thank you in advance

?

Code:

---

Sub vbax_58311_email_based_on_condition()

    Dim i As Long, j As Long
   
    Worksheets("Emp Information").Select

    If Application.CountA(Columns(7)) > 1 Then
        Range("G2:G" & Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlYes
    Else
        MsgBox "Please enter file full names to attach to emails to each working employee."
        Exit Sub
    End If
    'to ensure there are file full names and no blank cells in col G. no need to interrupt the code and make the user do this.
   
    With CreateObject("Outlook.Application")
        For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
            If Range("C" & i).Value = "Working" Then
                With .CreateItem(olMailItem)
                    .To = Range("B" & i).Value
                    .Subject = Range("D" & i).Value
                    .Body = Range("E" & i).Value
                    If Len(Range("F" & i)) > 0 Then .Attachments.Add Range("F" & i).Value
                    For j = 2 To Range("G" & Rows.Count).End(xlUp).Row
                        .Attachments.Add Range("G" & j).Value
                    Next j
                    .Display
                End With
            End If
        Next i
    End With

End Sub

---