VBA for sending rows of data if column A = current date. (Via email)

[paun_shotts]

Hi,

I have searched some similar threads on this board and have come across some code that ALMOST does what I want it to do, but Im still having some issues and would really like someone who understands VBA better than I do to help me out.

I have a workbook that we log returns in from our customers, once they are logged, we need to email some people to let them know that a return for them has arrived.
I only want to email the returns from TODAY and ignore the others in the list.
The date is written in column A, and there are headers in the log file.
In the email I want to include the data from columns A-I if the date in column A = today's date.

The code that I have managed to scrape together from other posts, is doing what I need it to do, apart from a few issues:
1) The email is only populating with column A
2) The headers are not included
3) It is including data in row A2, which is not today's date.

Additionally I would like to add another feature to this code:
In column "I" is written the initials of the team member to contact
I would like to send the email to whoever names appear in column I on any given day.
For Example, today, we have some returned for "DM" and some for "LF" so, we will need to email both of those people
Some days there may only be returns for "DM" so we only want to email him.
Is it possible to add this to the code?

Below is screenshot of the email that is generated with the below code:

I plan to run this code with a button placed on the sheet.
I will share the workbook and the code below:

Sub Send_Table_autofilter_2()

Dim MailBody As Range
Dim dwn As Range

'If filtered remove filter. Throws error if not filtered
  ActiveSheet.Range("A2").Activate
  On Error Resume Next
  ActiveSheet.ShowAllData

Set mWs = Worksheets("Sheet1")

'If MailBody sheet already exists then delete it
  If WorksheetExists("MailBody") Then
   Application.DisplayAlerts = False
    Worksheets("MailBody").Delete
   Application.DisplayAlerts = True
End If

'Add a sheet to copy all todays date rows to
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "MailBody"
 

'Return to the mail content sheet
   mWs.Activate

'Set range as column A to check for todays date. If yes is found skip filter and mail creation
Set rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
          
    For Each cell In rng
    If cell.Value = Date Then
    If Not cell.Offset(0, 9).Value = "yes" Then
  
  
'https://stackoverflow.com/questions/52340156/excel-macro-to-filter-column-to-todays-date
  With Worksheets("Sheet1")
    With rng
    .AutoFilter field:=1, Criteria1:=xlFilterToday, Operator:=xlFilterDynamic
    End With
   End With
      
'Copy the autofilter range and header to the MailBody sheet
    Worksheets("Sheet1").AutoFilter.Range.Offset(0, 0).Copy Sheets("MailBody").Range("A1")
 
  
'Need to add yes to each autofiltered row and date. Column A is the range so offset by 10 and 11 columns.
    For Each dwn In rng.SpecialCells(xlCellTypeVisible)
    rng.Offset(0, 9).Value = "yes"
    rng.Offset(0, 10).Value = Date
    Next
  
  
   ActiveSheet.Range("A2").Activate
   ActiveSheet.ShowAllData
              

' Change the following as needed
    sSendTo = "testing@testing123.com" ' Somehow I want to have this populate automatically based on the initials in column I?
    sSendCC = ""
    sSendBCC = ""
    sSubject = "Returned GRA's"
      
MsgStr = sTemp = "Hello!" & "<br><br>"
         sTemp = sTemp & "The below returns have been received and QC'd and can be returned to stock "
'         sTemp = sTemp & "for this project:" & "<br><br>"
' Assumes project name is in column B
'         sTemp = sTemp & " " & Cells(lRow, 2)
'         sTemp = sTemp & "Please take the appropriate"
'         sTemp = sTemp & "action." & "<br><br>"
         sTemp = sTemp & "Thank you!" & "<br>"


'Set Range on MailBody Sheet, then autofit it before copying to mail
  With Worksheets("MailBody")
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
 Set MailBody = .Range(.Cells(1, 1), .Cells(lRow, 9)) 'Columns 1 to 9
'Set MailBody = .Range(.Cells(1, 1), .Cells(lRow, 10)) - Columns 1 to 10
  End With
 
  MailBody.Columns.AutoFit
  
                      
'Create mail
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
  
        With OutMail
            .To = sSendTo
            .CC = sSendCC
            .Subject = sSubject
            .HTMLBody = sTemp & RangetoHTML(MailBody)
            .Display
        'send
       End With
          
          
  End If
End If


MailTo = ""
MailSubject = ""
Next


'Delete MailBody sheet
Application.DisplayAlerts = False
' Worksheets("MailBody").Delete
Application.DisplayAlerts = True
End Sub


Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
'Function from - https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

    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"


    'Copy the range and create a new workbook to past the data in
  
    rng.Copy
  
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial -4163, , False, False
        .Cells(1).PasteSpecial -4122, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With


    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=4, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=0)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    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=")


    'Close TempWB
    TempWB.Close savechanges:=False


    'Delete the htm file we used in this function
    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

'Does the worksheet exists
    Function WorksheetExists(WSName) As Boolean
        On Error Resume Next
        WorksheetExists = Worksheets(WSName).Name = WSName
    On Error GoTo 0
    End Function

GRA experiment.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	DATE IN	TIME IN	INITIALS	COURIER USED	CON NOTE / INVOICE #	GRA#	DESCRIPTION	# OF BOXES	ATTENTION TO:	E-MAILED?	DATE EMAILED
2	9/08/2023	10AM	SP	STARTRACK	51512	2307070	6XMESH	1	LF	yes	15/08/2023
3	9/08/2023	10AM	SP	BUDGET	25643	2308008	3XMESH	1	DM	yes	9/08/2023
4	9/08/2023	10AM	SP	BUDGET	23524	2308010	6XMESH	1	DM	yes	9/08/2023
5	9/08/2023	3PM	SP	STARTRACK	2323512	2307041	3XMESH	1	LF	yes	9/08/2023
6	9/08/2023	3PM	SP	STARTRACK	23523	2307060	1XMESH	1	LF	yes	9/08/2023
7	9/08/2023	3PM	SP	BUDGET	4642	2308009	16XMESH	1	DM	yes	9/08/2023
8	9/08/2023	3PM	SP	STARTRACK	4624	2308018	4XMESH	1	DM	yes	9/08/2023
9	11/08/2023	9AM	SP	STARTRACK	234112	2308006	7XMESH	1	DM	yes	11/08/2023
10	11/08/2023	9AM	SP	STARTRACK	35464	2308011	1XMESH	1	DM	yes	11/08/2023
11	11/08/2023	9AM	SP	STARTRACK	2326346	2308014	1XMESH	1	TS	yes	11/08/2023
12	14/08/2023	3PM	SP	STARTRACK	235246	2307066	1XMESH	1	LF	yes	14/08/2023
13	14/08/2023	3PM	SP	STARTRACK	252351	2308025	4XMESH	1	DM	yes	14/08/2023
14	15/08/2023	9AM	SP	STARTRACK	4263457	2308027	4XMESH	1	DM
15	15/08/2023	9AM	SP	STARTRACK	23525235	2308027	4XMESH	1	DM
16	15/08/2023	9AM	SP	STARTRACK	43643643	2308027	4XMESH	1	DM
17	15/08/2023	9AM	SP	STARTRACK	42364364	2308027	4XMESH	1	DM
18	15/08/2023	9AM	SP	STARTRACK	34634235	2308027	4XMESH	1	DM
19	15/08/2023	9AM	SP	STARTRACK	34623	2308027	4XMESH	1	DM
20	15/08/2023	9AM	SP	STARTRACK	23523	2308027	4XMESH	1	DM
21	15/08/2023	9AM	SP	STARTRACK	243623	2308027	4XMESH	1	DM
22	15/08/2023	9AM	SP	STARTRACK	26235	2308027	4XMESH	1	DM
23	15/08/2023	9AM	SP	STARTRACK	23234	2308027	4XMESH	1	DM
Sheet1

 

[paun_shotts]

Am I right to assume that the below line of code is setting MailBody to be columns A to I?
Is there something wrong with this line of code, because im only ever getting column A?

Set MailBody = .Range(.Cells(1, 1), .Cells(lRow, 9)) 'Columns 1 to 9