Macro to select & email [Closed]

Report
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
HI,

I have been trying hard to read all the posts here and find a solution to my problem but am not able to do so..

I have attached an excel sheet with various sheets and one sheet named "Summary".
In the 'summary' sheet I have created a button called Email status. When i click on this button i should be able to pick the rows from other sheets where the status in column P is "In Progress" and send an email.
The output should be be diplayed in the body of the message.

Please help!!

Thanks & Regards,
Sachin

2 replies

Hi,

I have managed to come up with the following code which works perfectly. The code below applies the filter condition to sheet B.

However I want the same condition to be used in Sheets C, D, E and F.. How do i modify this code???.



Option Explicit  

Sub Mail_Sheet_Outlook_Body()  
' Don't forget to copy the function RangetoHTML in the module.  
' Working in Office 2000-2010  
Dim ProgressRNG As Range  
Dim OutApp As Object  
Dim OutMail As Object  
Dim LastRow As Long  
      
Application.EnableEvents = False  
Application.ScreenUpdating = False  
       
    With Sheets("B")  
        .AutoFilterMode = False  
        LastRow = .Cells.Find("*", Cells(.Rows.Count, .Columns.Count), _  
            SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row  
        .Range("P:P").AutoFilter Field:=1, Criteria1:="In Progress"  
        Set ProgressRNG = .Range("A1:A" & LastRow) _  
            .SpecialCells(xlCellTypeVisible).EntireRow  
    End With  
      
    Set OutApp = CreateObject("Outlook.Application")  
    Set OutMail = OutApp.CreateItem(0)  
   
    On Error Resume Next  
    With OutMail  
        .To = "@gmail.in"  
        .CC = ""  
        .BCC = ""  
        .Subject = "Status as on "  
        .HTMLBody = RangetoHTML(ProgressRNG)  
        .Display   'or use .Send  
    End With  
    On Error GoTo 0  
   
    With Application  
        .EnableEvents = True  
        .ScreenUpdating = True  
    End With  
   
    Sheets("B").AutoFilterMode = False  
    Set OutMail = Nothing  
    Set OutApp = Nothing  
    Set ProgressRNG = Nothing  
End Sub

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
763
I am not sure if that meant that still one email is to be sent for all sheets or one email for one sheet.

This modified code will sent one email for each sheet. The modified code are highlighted

Sub Mail_Sheet_Outlook_Body()  
' Don't forget to copy the function RangetoHTML in the module.  
' Working in Office 2000-2010  
Dim ProgressRNG As Range  
Dim OutApp As Object  
Dim OutMail As Object  
Dim LastRow As Long  
Dim targetSheets As Variant  
Dim targetSheet As Variant  

    targetSheets = Array("B", "C", "D", "E", "F")  
      
    Application.EnableEvents = False  
    Application.ScreenUpdating = False  
         
    For Each targetSheet In targetSheets  

        With Sheets(CStr(targetSheet))  
          
            .AutoFilterMode = False  
            LastRow = .Cells.Find("*", Cells(.Rows.Count, .Columns.Count), _  
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row  
            .Range("P:P").AutoFilter Field:=1, Criteria1:="In Progress"  
            Set ProgressRNG = .Range("A1:A" & LastRow) _  
                .SpecialCells(xlCellTypeVisible).EntireRow  
        End With  
         
         Set OutApp = CreateObject("Outlook.Application")  
         Set OutMail = OutApp.CreateItem(0)  
          
         On Error Resume Next  
         With OutMail  
             .To = "@gmail.in"  
             .CC = ""  
             .BCC = ""  
             .Subject = "Status as on "  
             .HTMLBody = RangetoHTML(ProgressRNG)  
             .Display   'or use .Send  
         End With  
         On Error GoTo 0  
          
         With Application  
             .EnableEvents = True  
             .ScreenUpdating = True  
         End With  
          
         Sheets(CStr(targetSheet)).AutoFilterMode = False  
         Set OutMail = Nothing  
         Set OutApp = Nothing  
         Set ProgressRNG = Nothing  

    Next  

End Sub  
Thanks but I meant one email to be sent for all sheets..
Besides the code below gives an error " subscript out of range" at With Sheets(CStr(targetSheet))
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
763
Do you have sheets "B", "C", "D", "E", "F" ?

For sending one email, one has to know what function RangetoHTML does. IF you still get an error, could you please upload a sample file with sample data and macro etc on some shared site like https://authentification.site and post back here the link to allow to test.

But basic idea would be like this. New lines and moved lines are highlighted


Sub Mail_Sheet_Outlook_Body() 
' Don't forget to copy the function RangetoHTML in the module. 
' Working in Office 2000-2010 
Dim ProgressRNG As Range 
Dim OutApp As Object 
Dim OutMail As Object 
Dim LastRow As Long 
Dim targetSheets As Variant 
Dim targetSheet As Variant 
Dim sResult As String 

    targetSheets = Array("B", "C", "D", "E", "F") 
       
    Application.EnableEvents = False 
    Application.ScreenUpdating = False 
          
    For Each targetSheet In targetSheets 

        With Sheets(CStr(targetSheet)) 
           
            .AutoFilterMode = False 
            LastRow = .Cells.Find("*", Cells(.Rows.Count, .Columns.Count), _ 
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
            .Range("P:P").AutoFilter Field:=1, Criteria1:="In Progress" 
            Set ProgressRNG = .Range("A1:A" & LastRow) _ 
                .SpecialCells(xlCellTypeVisible).EntireRow 
        End With 
          
        sResult = sResult & RangetoHTML(ProgressRNG) 
         
         Sheets(CStr(targetSheet)).AutoFilterMode = False 

    Next 
 
    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 
      
    On Error Resume Next 
    With OutMail 
        .To = "@gmail.in" 
        .CC = "" 
        .BCC = "" 
        .Subject = "Status as on " 
        .HTMLBody = sResult 
        .Display   'or use .Send 
    End With 
    On Error GoTo 0 

    Set ProgressRNG = Nothing     
    Set OutMail = Nothing 
    Set OutApp = Nothing 
     
    With Application 
        .EnableEvents = True 
        .ScreenUpdating = True 
    End With 
     
End Sub 

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!