Send an email with "missing" text range rows VBA

[dacast]

i have a list of missing and file names hyperlinks

I want to create a button that, when clicked, reads the entire column and if it finds "missing," will collect those rows range and then will go to column A and read the first 2 letters and, based on that, will send an email to the corresponding person with the missing rows and header. please see the image for clarification

in this sample:
will read column C will collect rows 78 to 81, and an email will be sent to smith.bbb@compnay.com with only these 4 rows and ABC columns

thank you for your help

 

[mumps]

For each "missing" in column B, can the first two letters of the corresponding value in column A be different in each row? For example, the current values in A78:A81 all begin with "MI". Could each value in this range begin with different two letters?

 

[dacast]

For each "missing" in column B, can the first two letters of the corresponding value in column A be different in each row? For example, the current values in A78:A81 all begin with "MI". Could each value in this range begin with different two letters?

There are 5 locations
CE, RA, ME, MI. each location has different people (different emails)
In this case location MI has A78:A81 missing documents and email should be sent to only the people for that location

 

[mumps]

Try:

Sub CreateEmails()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, rng As Range, ws2 As Worksheet, ws3 As Worksheet, lRow As Long, fnd As Range
    Set ws2 = Sheets("Sheet2")
    Set ws3 = Sheets("Sheet3")
    With ws3
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("A5").CurrentRegion.AutoFilter 3, "missing"
        fvisrow = .Range("A6:A" & lRow).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
        Set fnd = ws2.Range("C:C").Find(Left(.Range("A" & fvisrow), 2), LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            Set rng = .Range("A6:C" & lRow).SpecialCells(xlCellTypeVisible)
        End If
        .Range("A1").AutoFilter
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = fnd.Offset(, 4)
            .Subject = ""
            .HTMLBody = RangetoHTML(rng)
            .Display
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
    TempWB.Close savechanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

 

[dacast]

Try:

Sub CreateEmails()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, rng As Range, ws2 As Worksheet, ws3 As Worksheet, lRow As Long, fnd As Range
    Set ws2 = Sheets("Sheet2")
    Set ws3 = Sheets("Sheet3")
    With ws3
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("A5").CurrentRegion.AutoFilter 3, "missing"
        fvisrow = .Range("A6:A" & lRow).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
        Set fnd = ws2.Range("C:C").Find(Left(.Range("A" & fvisrow), 2), LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            Set rng = .Range("A6:C" & lRow).SpecialCells(xlCellTypeVisible)
        End If
        .Range("A1").AutoFilter
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = fnd.Offset(, 4)
            .Subject = ""
            .HTMLBody = RangetoHTML(rng)
            .Display
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
    TempWB.Close savechanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Thank you for the code it worked so far

some aspects I would like to change or point out
1. is only sending emails to one person in the list. For example, I have MI and RA missing documents, and it only created an email for MI people (see images 1 & 2)
For example :

• all MI cells should be sent to

jey.D@company.com and luck.m@company.com

• and all RA should be sent to

mike.C@company.com and sam.J@company.com

(if is easier create one email and include all 4 in it with the missing ones in this case)

2. how can I modify the code to read per column as this action has to be done every month ( see image 3)

3. every time I use the code it reset filters and removes them. there is a way to fix this?

 

[dacast]

Thank you for the code it worked so far

some aspects I would like to change or point out
1. is only sending emails to one person in the list. For example, I have MI and RA missing documents, and it only created an email for MI people (see images 1 & 2)
For example :

• all MI cells should be sent to

jey.D@company.com and luck.m@company.com

• and all RA should be sent to

mike.C@company.com and sam.J@company.com

(if is easier create one email and include all 4 in it with the missing ones in this case)

View attachment 87999View attachment 88000

2. how can I modify the code to read per column as this action has to be done every month ( see image 3)

View attachment 88001

3. every time I use the code it reset filters and removes them. there is a way to fix this?

4. how can I add the headers (row 5 sheet3)

 

[mumps]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[dacast]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Hi mumps
Sorry for inconvenience

Please see the link bellow

PMP-Collect Mai 2023-(Feb 2023 )_V5.xlsm

Shared with Dropbox

www.dropbox.com

Project problem
-Send an email with missing items-

After filling column C, all "missing" cells should be compiled and sent an email to the person responsible and the supervisor remaining to send files.

1st action
Button on C1 (sheet "MONTHS") should activate VBA code that will send "missing" cells from columns A and C with headers to the recipients (emails contained in Sheet "General inf")
if RA-.. are missing email should be sent to RA people (G6 and I6)(emails contained in Sheet "General inf")
if MI_.. are missing email should be sent to MI people (G7 and I7)(emails contained in Sheet "General inf")
and like this will do all 4 locations (C4:C7 sheet General Inf)
2nd and next actions
Consecutive month's action will be repeated with the next month button(E1,G1,...), but this time only will send columns A and the corresponding column month "missing" items with headers.

Hope this clarifies

 

[mumps]

Since you have 12 buttons, one for each month, you would need 12 macros. Would it work for you if the macro prompted the user to enter the month name or column letter which you want to process? If this approach is OK, you would need only one button and one macro.

 

[dacast]

Since you have 12 buttons, one for each month, you would need 12 macros. Would it work for you if the macro prompted the user to enter the month name or column letter which you want to process? If this approach is OK, you would need only one button and one macro.

That sounds better that i have in mind . so yes is ok