Solved

# Filter colum 'F" and send the user a mail with the details

Posted on 2008-10-24
270 Views
Hi,

Need to filter as per managers and mail them with the A,B,C,D,E data
With headers in a border box

Filter colum "F" find a manager mail him his subordinate details .
Related to such output
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23844631.html?cid=239#a22797712
Regards
Sharath
Full-Time-Internet-Users.xls
0
Question by:bsharath
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 3
• 2

LVL 50

Accepted Solution

Dave Brett earned 500 total points
ID: 22799650
How this

Cheers

Dave
``````Option Explicit

Sub ManagerMail()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim cel As Range
Dim MyDic As Object
Set MyDic = CreateObject("Scripting.Dictionary")

Set rng1 = Sheets(1).Range([f2], Cells(ActiveSheet.Rows.Count, "f").End(xlUp)).SpecialCells(xlConstants)
For Each cel In rng1
Set rng3 = Nothing
If cel.Value <> vbNullString Then
If Not MyDic.exists(cel.Value) Then
Set rng2 = rng1.Find(cel.Value, rng1.Cells(1), xlValues, xlWhole, xlByRows, xlPrevious)
If Not rng2 Is Nothing Then
Set rng3 = Range(Cells(rng2.Row, "A"), Cells(rng2.Row, "E"))
Do
Set rng2 = rng1.FindNext(rng2)
Set rng3 = Union(rng3, Range(Cells(rng2.Row, "A"), Cells(rng2.Row, "E")))
End If
Set doit = Mailem(cel.Value, rng3)
Else
End If
End If

Next
End Sub

Function Mailem(Recip As String, ByVal rng3 As Range)
Dim outApp, outMail
Dim tempStrStart As String, tempStrMid As String, tempStrFinish As String, tempStrCel As String, tempStr As String
Dim r As Range, cel As Range
Set outApp = CreateObject("Outlook.Application")

tempStrStart = "<table border=1><tr><th>Groups</th><th>Full Name</th><th>Title</th><th>Description</th><th>Department</th></tr>"
tempStrFinish = "</table>"

For Each r In rng3.Rows
tempStrCel = vbNullString
For Each cel In r.Cells
tempStrCel = tempStrCel & "<td>" & cel.Value & "</td>"
Next
tempStrMid = tempStrMid & tempStrCel & "</tr>"
Next

tempStr = tempStrStart & tempStrMid & tempStrFinish
outApp.Session.Logon
Set outMail = outApp.CreateItem(0)
With outMail
.To = Recip
.Subject = "Groups"
.htmlBody = "Hi " & Recip & ",<br>Below is the data.<br><br>" & tempStr & "<br><br>Regards<br>Sharath"
.Recipients.ResolveAll
.Display
End With
Set outMail = Nothing
Set outApp = Nothing
End Function
``````
0

LVL 11

Author Comment

ID: 22800058
Thanks Dave. The first mail is displayed the the first 2 rows then get an Run time error 13 error
When debug goes here
Set doit = Mailem(cel.Value, rng3)
0

LVL 50

Expert Comment

ID: 22800196
try
doit = Mailem(cel.Value, rng3)

Cheers
0

LVL 11

Author Comment

ID: 22800356
Thank U Dave worked perfect....
0

LVL 50

Expert Comment

ID: 22800447
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
Originally, this post was published on Monitis Blog, you can check it here . In business circles, we sometimes hear that today is the “age of the customer.” And so it is. Thanks to the enormous advances over the past few years in consumer techno…
The viewer will learn how to clear a vector as well as how to detect empty vectors in C++.
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
###### Suggested Courses
Course of the Month4 days, 2 hours left to enroll