[sachins19]

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.. So please help.

I have attached an excel sheet to explain my doubt.
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 sheet B & sheet D where the status is "In Progress" [Column P] and send an email. The output should be diplayed in the body of the message.

Please help!

Thanks & Regards,
Sachin

[kahuna45]

Sachin:
I reviewed your spreadsheet, but did not fing any formulas, using a vlookup fuction would serve your purpose

[sachins19]

Sachin:
I reviewed your spreadsheet, but did not fing any formulas, using a vlookup fuction would serve your purpose

Hey u didn't get my question.. There are no formuaes in this sheet.. Just want a macro as per the description above...

[sachins19]

Absolutely no one can solve this??

[JBeaucaire]

There are only a few contributors in this particular section of the forum. Apparently none of us use the features you're after enough to warrant offering you advice on it.

Questions on other topics/needs might garner many suggestions, just not this one. So far.

[sachins19]

Hi,

I have used the code below to select the range in a particular workseet and email the same.

However I want the macro to check for a condition (Column P= 'some text') and email only those rows.

Option Explicit

Sub Mail_Sheet_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
Set rng = Sheets("B").UsedRange
'Set rng = ActiveSheet.UsedRange
'You can also use a sheet name

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(rng)
.Display 'or use .Send
End With
On Error Go to 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

[KISS]

The pseudo-code for "some text in column P" would be:

sometext =0
For c = 1 to #rows
if istext(Row:column) then sometext=1; break
next c

istext is a real function

Does that help?

[sachins19]

Thanks but what I am trying to say is that based on a criteria I want some rows to be selected. So say for example I want the rows with "In Progress" (which is column P in the attached excel sheet) to be selected

[JBeaucaire]

As long as your macro as a whole works, I've adapted it to do an AutoFilter on column P to show all rows "In Progress" and set ProgressRNG to those rows. Then it is used in your existing macro.

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

[sachins19]

One more query... Supposing there are more worksheets say C,D,E,F. In such a scenario, how do we consider these sheets as well, in the query?

[JBeaucaire]

I know how to loop through sheets, I don't know about multi-sheet ranges. Maybe if the all the data wanted is copied to a temp sheet together and THEN copied enmasse to the "body" of the email, would that work?

I have macros on my website for parsing data, maybe you can adapt one of those.

I'll have to think about it awhile. You wouldn't have a sample workbook to upload to help here, would you? You can sanitize any sensitive data with generic data...

[JBeaucaire]

Ok, it took a bit of fiddling (new stuff for me here) but I think is working now.

Option Explicit

Sub Mail_Sheet_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim ws As Worksheet, wsTemp As Worksheet
Dim OutApp As Object
Dim OutMail As Object
Dim LastRow As Long
    
Application.EnableEvents = False
Application.ScreenUpdating = False

If Not Evaluate("ISREF(Temp!A1)") Then
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    Range("A1") = "Data"
End If

Set wsTemp = Sheets("Temp")
     
'For Each ws In Worksheets(Array("B", "C", "D", "E", "F"))
    With ws
        .AutoFilterMode = False
        .Range("P4:P" & .Rows.Count).AutoFilter Field:=1, Criteria1:="In Progress"
        LastRow = .Range("P" & Rows.Count).End(xlUp).Row
        If LastRow > 4 Then
            .Range("A2").Copy wsTemp.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .Range("A4:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow _
                .Copy wsTemp.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
        .AutoFilterMode = False
    End With
Next ws
            
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
    
On Error Resume Next
    With OutMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "Status for IN PROGRESS as on " & Format(Date, "MM-DD-YY")
        .HTMLBody = RangetoHTML(wsTemp.UsedRange)
        .Display   'or use .Send
        '.send
    End With
On Error GoTo 0

Application.DisplayAlerts = False
    wsTemp.Delete
Set OutMail = Nothing
Set OutApp = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

[sachins19]

Thanks but when I execute this code it gives me lots of errors.
Can you please check. Am attching the original sheet for your perusal.

[JBeaucaire]

One more:

Option Explicit

Sub Mail_Sheet_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim ws      As Worksheet
Dim wsTemp  As Worksheet
Dim OutApp  As Object
Dim OutMail As Object
Dim LastRow As Long
Dim NextRow As Long
    
Application.EnableEvents = False
Application.ScreenUpdating = False

If Not Evaluate("ISREF(Temp!A1)") Then
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    Range("A1") = "Data"
Else
    Sheets("Temp").Range("A2:Z" & Rows.Count).Clear
End If

NextRow = 2

Set wsTemp = Sheets("Temp")
     
For Each ws In Worksheets(Array("B", "C", "D", "E", "F"))
    With ws
        .AutoFilterMode = False
        .Range("P:P").AutoFilter Field:=1, Criteria1:="In Progress"
        LastRow = .Range("P" & Rows.Count).End(xlUp).Row
        If LastRow > 1 Then
            .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow _
                    .Copy wsTemp.Range("A" & NextRow)
            NextRow = wsTemp.Range("A" & Rows.Count).End(xlUp).Row + 1
        End If
        .AutoFilterMode = False
    End With
Next ws
            
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
    
On Error Resume Next
    With OutMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "Status for IN PROGRESS as on " & Format(Date, "MM-DD-YY")
        .HTMLBody = RangetoHTML(wsTemp.UsedRange)
        .Display   'or use .Send
        '.send
    End With
On Error GoTo 0

Application.DisplayAlerts = False
    wsTemp.Delete
Set OutMail = Nothing
Set OutApp = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub