PDA

View Full Version : Excel Macro needed!


sachins19
Apr 27, 2010, 05:39 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.. 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
Apr 27, 2010, 06:01 AM
Sachin:
I reviewed your spreadsheet, but did not fing any formulas, using a vlookup fuction would serve your purpose

sachins19
Apr 27, 2010, 08:23 AM
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
Apr 29, 2010, 05:30 AM
Absolutely no one can solve this??

JBeaucaire
Apr 29, 2010, 10:17 AM
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
Apr 30, 2010, 11:33 PM
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
Apr 30, 2010, 11:45 PM
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
May 1, 2010, 03:22 AM
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
May 1, 2010, 09:44 AM
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
May 1, 2010, 11:54 AM
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
May 1, 2010, 01:17 PM
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 (https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/files) 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
May 1, 2010, 06:11 PM
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
May 1, 2010, 11:38 PM
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
May 2, 2010, 03:13 PM
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