Previous Topic Next Topic

Macro to select & email

Closed
Sach - May 1, 2010 at 12:59 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - May 2, 2010 at 06:13 AM
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 responses

Answer 1 / 2
Sach
May 1, 2010 at 01:51 PM
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
0
Answer 2 / 2
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
May 1, 2010 at 03:17 PM
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
0
Sach
May 2, 2010 at 01:24 AM
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))
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
May 2, 2010 at 06:13 AM
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
0

Similar discussions

Why can't I bridge connect?
ryno -
Qiqi -

15 responses
Can't log in to Yahoo account
ashley -
TiredOfSCAMS -

16 responses
Can't select text
Meshack -
HelpiOS -

1 response