Send mail from excel having specific text : little macro help!

[jeetusaini85]

Hi Friends,

Need your help to modify this macro.

I have a macro in which we can mail through excel sheet having a specific text in last column and row. It's working perfect as i want but now i want to modify this according to my another need.

In this macro it is searching for last row and last column with a specific text "ABS", when it searched for "ABS" it is ready to mail only those receipts in which "ABS" is mentioned. Now here i want a change, it is mail to all receipt having "ABS" every time but i want to search it from top to bottom for "ABS" and when it will find last "ABS" in column it should mail to that receipt only. I tried it but not success.

I hope i clarify this clearly.

The code is:

Option Explicit

Sub Send_Mail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim LR As Long, LC As Long
    Dim ws As Worksheet
    Dim rng As Range, cel As Range
    Dim strBody As String
    Dim x As String

    Set OutApp = CreateObject("Outlook.Application")
    Set ws = Sheets("PartsData")
    Application.ScreenUpdating = False
    With ws
        LC = .Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        .Range(.Cells(1, 2), .Cells(LR, LC)).AutoFilter field:=LC - 1, Criteria1:="Yes"
        Set rng = .AutoFilter.Range
        x = rng.Columns(30).SpecialCells(xlCellTypeVisible).Count - 1
        If x >= 1 Then
            For Each cel In .Range(.Cells(2, 30), .Cells(LR, 30)).SpecialCells(xlCellTypeVisible)

                strBody = "Dear Valuable Customer," & vbCrLf & vbCrLf _
                        & "Greetings from Intec Capital Limited!!!" & vbCrLf & vbCrLf _
                        & "We thank you for giving us an opportunity to serve you." & vbCrLf & vbCrLf _
                        & "We have noted your concern and your request will be resolved within 7 working days." & vbCrLf & vbCrLf _
                        & "Assuring you of our best services always." & vbCrLf & vbCrLf _
                        & "Your reference number for raised query & future communication is :- " & ws.Cells(cel.Row, "C").Value & vbCrLf & vbCrLf & vbCrLf _
                        & "Best Wishes," & vbCrLf _
                        & "Customer Care Team" & vbCrLf _

                                    
                Set OutMail = OutApp.CreateItem(0)

                On Error Resume Next
                With OutMail
                    .to = ws.Cells(cel.Row, "I").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "Auto Reply : Reference No. - " & ws.Cells(cel.Row, "C").Value
                    .Body = strBody
                    .Display    '.Send   'or use .Display
                End With
                On Error GoTo 0

            Next cel
        End If
        .AutoFilterMode = False
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

[jeetusaini85]

Bump

 

[jeetusaini85]

Bump

 

[jeetusaini85]

Hi Friends,

Sorted down the query myself. Now only one mail will send to the customer having last "Yes" status in column.

But it is sending the mail to that customer also who is having "Yes" status not in last cell of the column. I want that it will send mail only to that customer who is having "Yes" in last cell of column. In another way, the data is row wise, every time a new data is inserted in row with status, if last row have "Yes" status in last cell of the column it will send the mail , if having "No" then no mail will send. and When next data will enter in row then check it again for "Yes" and "No" and if found "Yes" send the mail.

Option Explicit

Sub Send_Mail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim LR As Long, LC As Long
    Dim ws As Worksheet
    Dim rng As Range, cel As Range
    Dim strBody As String
    Dim x As String

    Set OutApp = CreateObject("Outlook.Application")
    Set ws = Sheets("PartsData")
    Application.ScreenUpdating = False
    With ws
        LC = .Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        .Range(.Cells(1, 2), .Cells(LR, LC)).AutoFilter field:=LC - 1, Criteria1:="Yes"
        Set rng = .AutoFilter.Range
        x = rng.Columns(30).SpecialCells(xlCellTypeVisible).Count - 1
        If x >= 1 Then
            For Each cel In .Range(.Cells(LC, 30), .Cells(LR, 30)).SpecialCells(xlCellTypeLastCell)
            
            'For Each cel In .Range(.Cells(2, 30), .Cells(LR, 30)).SpecialCells(xlCellTypeVisible)
                strBody = "Dear Valuable Customer," & vbCrLf & vbCrLf _
                        & "Greetings from Intec Capital Limited!!!" & vbCrLf & vbCrLf _
                        & "We thank you for giving us an opportunity to serve you." & vbCrLf & vbCrLf _
                         & "We have noted your concern and your request will be resolved  within 7 working days." & vbCrLf & vbCrLf _
                        & "Assuring you of our best services always." & vbCrLf & vbCrLf _
                         & "Your reference number for raised query & future  communication is :- " & ws.Cells(cel.Row, "C").Value & vbCrLf  & vbCrLf & vbCrLf _
                        & "Best Wishes," & vbCrLf _
                        & "Customer Care Team" & vbCrLf _
                        & vbCrLf & "Intec Capital Ltd" _

                                    
                Set OutMail = OutApp.CreateItem(0)

                On Error Resume Next
                With OutMail
                    .to = ws.Cells(cel.Row, "I").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "Auto Reply : Reference No. - " & ws.Cells(cel.Row, "C").Value
                    .Body = strBody
                    .Display    '.Send   'or use .Display
                End With
                On Error GoTo 0

            Next cel
        End If
        .AutoFilterMode = False
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

[jeetusaini85]

Bump

 

[jeetusaini85]

Please Help !!!

 

[jeetusaini85]

Bump!!!