Find the Last Row of Data in Spreadsheet, Copy it to Email

[JeremyS]

I am working on a project for my department involving a request off log in Excel. I developed a userform so we have standardized responses that are transferred to a different sheet in the workbook, and I've set up the file so that when someone requests off work and saves the file, Outlook opens up and a link to the Excel file gets emailed to the relevant parties.
My boss wants me to add one final thing to this...he wants the last line of data (the most recent request off) to be pasted into the email, so he can get a preview of who requested off.
I've found a lot on finding the last row populated with data...but I'm relatively new to VBA, so I'm having a hard time integrating this request into the existing code. The code for the email is shown below...it is saved to the workbook. If needed, I can post the code for the Userform. This code does work...Outlook does open. I just need to paste the last row from the worksheet (which is the most recent information from the userform) into the email (title or body...does not matter, really). I tried using code that was similar to what was in the userform for transferring data to the spreadsheet (for example: ws.Cells(iRow, 1).Value = Me.LastName.Value) and placing into the code below. It did not really work. Any suggestions would be appreciated, and thanks in advance for the help. I did try the DeBruin website, various internet sources, and searching through the forum here for previous answers to similar questions. Like I said, I'm fairly new to this, so the answer might have went over my head.

Email when file is saved

[/FONT][/COLOR]Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Outlook As Object, EMail As Object
Dim ws As Worksheet
Set ws = Worksheets("RequestLog")

Set Outlook = CreateObject("Outlook.Application")

Set EMail = Outlook.CreateItem(0)

With EMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Employee Has Requested Off Work: Please See Attached for Updated Request Off Log"
.HTMLBody = _
"
" & _
"
Chr(34) & ">Download Now
"
.Display

End With

Set EMail = Nothing

Set Outlook = Nothing
End Sub

 

[daverunt]

Hi,

It might be helpful to see all of the code if there are problems.

I am assuming from what you are saying that last row content is in one cell and that it is already entered into the worksheet prior to trying to access it with this macro?

You should be able to get the content of the last row with:

LastRow = ws.Cells(Rows.Count, "A").End(xlUp)

and add it to the body

.HTMLBody = LastRow & "whatever else you have added there but doesn't look right in the post"

 

[JeremyS]

See below for complete code. The last row has information that is located in eight columns across the row and is not in a single cell. Bolded and underlined shows what I've tried most recently...I haven't had much luck. It either does not put the required information in, or results in compile, expected end of expression, or invalid characters errors. I'm still quite new to this.

Private Sub UserForm_Activate()     'Populates the comboboxes with data when the user opens the userform
With Hours_ComboBox                 'Drop down menu for the number of hours a person wishes to request off
.AddItem "1"
.AddItem "2"
.AddItem "3"
.AddItem "4"
.AddItem "5"
.AddItem "6"
.AddItem "7"
.AddItem "8"
End With


With TypeOff_ComboBox               'Drop down menu for the type of time off a person wishes to request off
.AddItem "AFC"
.AddItem "Bereavement"
.AddItem "FMLA"
.AddItem "Jury Duty"
.AddItem "Personal Holiday"
.AddItem "Vacation"
End With
End Sub




Private Sub cmdclose_Click()    'Clears out the form when the user clicks "Close Form"
Unload Me
End Sub


Private Sub cmdrequest_Click()      'Sends the data to the Request Log worksheet when the user clicks on "Submit Request Off"


'Checks for Required Fields
'"LastName" is Required Field
    If LastName = "" Then                                          'If Blank Then, Error Box
        GoTo More_Information_Required
        Else:                                                      'Else: Continue normally
        End If
    If FirstName = "" Then                                          'If Blank Then, Error Box
        GoTo More_Information_Required
        Else:                                                      'Else: Continue normally
        End If
    If EmployeeID = "" Then                                          'If Blank Then, Error Box
        GoTo More_Information_Required
        Else:                                                      'Else: Continue normally
        End If
    If Department = "" Then                                          'If Blank Then, Error Box
        GoTo More_Information_Required
        Else:                                                      'Else: Continue normally
        End If
    If Hours_ComboBox = "" Then                                       'If Blank Then, Error Box
        GoTo More_Information_Required
        Else:                                                      'Else: Continue normally
        End If
    If TypeOff_ComboBox = "" Then                                      'If Blank Then, Error Box
        GoTo More_Information_Required
        Else:                                                      'Else: Continue normally
        End If
        
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("RequestLog")




'find first empty row in database by iteratively looping through rows until it finds a row that is completely blank (no information in any of the cells)
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1


'Copies the information from the userform to the first empty row in the RequestLog worksheet
With ws
  .Cells(iRow, 1).Value = Me.LastName.Value             'Places data from Last name text box into column A
  .Cells(iRow, 2).Value = Me.FirstName.Value            'Places data from First name text box into column B
  .Cells(iRow, 3).Value = Me.EmployeeID.Value           'Places data from Employee ID # text box into column C
  .Cells(iRow, 4).Value = Me.Department.Value           'Places data from Department text box into column D
  .Cells(iRow, 5).Value = Me.Calendar.Value             'Places user selected data from Calendar Monthly View control into corresponding column E
  .Cells(iRow, 6).Value = Me.Hours_ComboBox.Value       'Places number of hours requested into column F
  .Cells(iRow, 7).Value = Me.TypeOff_ComboBox.Value     'Places type of time off into column G
  .Cells(iRow, 8).Value = Me.CommentBox.Value           'Places data from Comments text box into column H


End With




[B]Dim Outlook As Object, EMail As Object  'Opens Outlook Email Application when Submit Request Off command button is clicked[/B]
[B]Set Outlook = CreateObject("Outlook.Application") 'The next two lines specify Outlook as the email application[/B]
[B]Set EMail = Outlook.CreateItem(0)[/B]
[B]With EMail  'The next four fields are for who the email is sent to, what the subject and body of the email are, and what file folder is linked in the body of the email[/B]
[B]    .To = ""[/B]
[B]    .CC = ""[/B]
[B]    .BCC = ""[/B]
[B]    .Subject = "Employee Has Requested Off: Please Check Linked Workbook"[/B]
[B]    .HTMLBody = [U].Cells(iRow, 1).Value = Me.LastName.Value[/U] &[/B]
[B]    "</p>" & _[/B]
[B]    "<p><a href= " & Chr(34) & "K:Drive" & _[/B]
[B]    Chr(34) & ">Download Now</a></p>"[/B]
[B]    .Display[/B]

[B]End With[/B]

[B]Set EMail = Nothing[/B]

[B]Set Outlook = Nothing[/B]


GoTo RequestOffEnd


'The next six If statements prevent the transfer of information to the RequestLog spreadsheet if the userform is not complete


If LastName = "" Then
Cancel = 1
End If


If FirstName = "" Then
Cancel = 1
End If


If EmployeeID = "" Then
Cancel = 1
End If


If Department = "" Then
Cancel = 1
End If


If Hours_ComboBox = "" Then
Cancel = 1
End If


If TypeOff_ComboBox = "" Then
Cancel = 1
End If




More_Information_Required:
        'Checks each required field and highlights for clarity
                If LastName = "" Then                                          'If Blank Then,
                    LastName.BackColor = &HFF&                                'Makes the Color of the Box Red for emphasis
                Else:                                                                           'Else: Continue normally
                    LastName.BackColor = &H80000005                                'Puts the Color of the Box back to White if filled out
                End If
                
                If FirstName = "" Then                                          'If Blank Then,
                    FirstName.BackColor = &HFF&                                     'Makes the Color of the Box Red for emphasis
                Else:                                                                           'Else: Continue normally
                    FirstName.BackColor = &H80000005                                'Puts the Color of the Box back to White if filled out
                End If
                
                If EmployeeID = "" Then                                          'If Blank Then,
                    EmployeeID.BackColor = &HFF&                                     'Makes the Color of the Box Red for emphasis
                Else:                                                                           'Else: Continue normally
                    EmployeeID.BackColor = &H80000005                                'Puts the Color of the Box back to White if filled out
                End If
                If Department = "" Then                                          'If Blank Then,
                    Department.BackColor = &HFF&                                      'Makes the Color of the Box Red for emphasis
                Else:                                                                           'Else: Continue normally
                    Department.BackColor = &H80000005                                'Puts the Color of the Box back to White if filled out
                End If
                If Hours_ComboBox = "" Then                                          'If Blank Then,
                    Hours_ComboBox.BackColor = &HFF&                                      'Makes the Color of the Box Red for emphasis
                Else:                                                                           'Else: Continue normally
                    Hours_ComboBox.BackColor = &H80000005                                'Puts the Color of the Box back to White if filled out
                End If
                If TypeOff_ComboBox = "" Then                                          'If Blank Then,
                    TypeOff_ComboBox.BackColor = &HFF&                                      'Makes the Color of the Box Red for emphasis
                Else:                                                                           'Else: Continue normally
                    TypeOff_ComboBox.BackColor = &H80000005                                'Puts the Color of the Box back to White if filled out
                End If
            
            
    'Creates the Error Message Box
            Msg = "The following are REQUIRED Fields" & vbCrLf
            Msg = Msg & "Last Name" & vbCrLf
            Msg = Msg & "First Name" & vbCrLf
            Msg = Msg & "Employee ID" & vbCrLf
            Msg = Msg & "Department" & vbCrLf
            Msg = Msg & "Selecting the Date Using the Calendar" & vbCrLf
            Msg = Msg & "Number of Hours Requested Off" & vbCrLf
            Msg = Msg & "Type of Time Requested Off" & vbCrLf
            Msg = Msg & "(Please Fill Out Completely and Re-Submit)" & vbCrLf
                Ans = MsgBox(Msg, vbOKOnly)
            Select Case Ans
                Case vbOK       'Allows User to Re-Edit Userform
                    GoTo RequestOffEnd
            End Select


RequestOffEnd:
End Sub

 

[JeremyS]

Sorry, the code for the email didn't look right...I see what you mean. It looks better here:

Dim Outlook As Object, EMail As Object 'Opens Outlook Email Application when Submit Request Off command button is clicked
Set Outlook = CreateObject("Outlook.Application") 'The next two lines specify Outlook as the email application
Set EMail = Outlook.CreateItem(0)
With EMail 'The next four fields are for who the email is sent to, what the subject and body of the email are, and what file folder is linked in the body of the email
.To = ""
.CC = ""
.BCC = ""
.Subject = "Employee Has Requested Off: Please Check Linked Workbook"
.HTMLBody = .Cells(iRow, 1).Value = Me.LastName.Value &
"</p>" & _
"<p><a href= " & Chr(34) & "K:\Operations\Production Control\JeremySMaterials\RequestOffUserForm.xlsm" & _
Chr(34) & ">Download Now</a></p>"
.Display

 

[daverunt]

Hi,

copying a range of cells to an email isn't as straightforward as a single cell as it isn't a string.
There are a couple of ways of doing this we will use the function RangetoHTML from RonDeBruins site, which is a good place to go for email info:
Mail Range/Selection in the body of the mail

Firstly we find the LastRow of column A then we know from your statements that the last column is 8.
We use that to create html of the range and put that in the body of the mail.

The other method is to concatenate the range into a string so we don't need to use HTML in Outlook but we'll ignore that here.

The function - just copy and paste after the end sub of the mail as it is below.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim Outlook As Object, EMail As Object
 Dim ws As Worksheet
 Set ws = Worksheets("RequestLog")

 Set Outlook = CreateObject("Outlook.Application")

 Set EMail = Outlook.CreateItem(0)


 LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
 Set rng = ws.Range(Cells(LastRow, 1), Cells(LastRow, 8))

 With EMail
 .To = ""
 .CC = ""
 .BCC = ""
 .Subject = "Employee Has Requested Off Work: Please See Attached for Updated Request Off Log"
 .HTMLBody = RangetoHTML(rng)


'still can't see what you are trying to do here. If it looks like 
'this in your macro then comment it out to make sure the LastRow part of the code is working.
'Then post what you are trying to achieve with the code below

'Start comment out
' _
' "
' " & _                   
' "                       
' Chr(34) & ">Download Now
' "
'End Comment Out


 .Display

 End With

 Set EMail = Nothing

 Set Outlook = Nothing
 End Sub 

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    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 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

    'Publish the sheet to a htm file
    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

    '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

 

[JeremyS]

I made sure to put the HTML tags around the one part of the code that didn't look right. I forgot about that, sorry.

<div>

Dim Outlook As Object, EMail As Object  'Opens Outlook Email Application when Submit Request Off command button is clicked
Set Outlook = CreateObject("Outlook.Application") 'The next two lines specify Outlook as the email application
Set EMail = Outlook.CreateItem(0)
With EMail  'The next four fields are for who the email is sent to, what the subject and body of the email are, and what file folder is linked in the body of the email
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Employee Has Requested Off: Please Check Linked Workbook"
   [HTML] .HTMLBody = "</p>" & _    "<p><a href= " & Chr(34) & "K:\Operations\Production Control\JeremySMaterials\RequestOffUserForm.xlsm" & _    Chr(34) & ">Download Now</a></p>"    .Display[/HTML]

End With


Set EMail = Nothing


Set Outlook = Nothing

Set Outlook = Nothing

Hi,

copying a range of cells to an email isn't as straightforward as a single cell as it isn't a string.
There are a couple of ways of doing this we will use the function RangetoHTML from RonDeBruins site, which is a good place to go for email info:
Mail Range/Selection in the body of the mail

Firstly we find the LastRow of column A then we know from your statements that the last column is 8.
We use that to create html of the range and put that in the body of the mail.

The other method is to concatenate the range into a string so we don't need to use HTML in Outlook but we'll ignore that here.

The function - just copy and paste after the end sub of the mail as it is below.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim Outlook As Object, EMail As Object
 Dim ws As Worksheet
 Set ws = Worksheets("RequestLog")

 Set Outlook = CreateObject("Outlook.Application")

 Set EMail = Outlook.CreateItem(0)


 LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
 Set rng = ws.Range(Cells(LastRow, 1), Cells(LastRow, 8))

 With EMail
 .To = ""
 .CC = ""
 .BCC = ""
 .Subject = "Employee Has Requested Off Work: Please See Attached for Updated Request Off Log"
 .HTMLBody = RangetoHTML(rng)


'still can't see what you are trying to do here. If it looks like 
'this in your macro then comment it out to make sure the LastRow part of the code is working.
'Then post what you are trying to achieve with the code below

'Start comment out
' _
' "
' " & _                   
' "                       
' Chr(34) & ">Download Now
' "
'End Comment Out


 .Display

 End With

 Set EMail = Nothing

 Set Outlook = Nothing
 End Sub 

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    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 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

    'Publish the sheet to a htm file
    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

    '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

 

[daverunt]

Hi,

you didn't say whether any of it worked or not?
Here's the code as I see it. Hope it posts OK with the HTML.
Just paste the HTML code line after the .HTMLBody line

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim Outlook As Object, EMail As Object
 Dim ws As Worksheet
 Set ws = Worksheets("RequestLog")


 Set Outlook = CreateObject("Outlook.Application")
 Set EMail = Outlook.CreateItem(0)
 
 
 LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
 Set rng = ws.Range(Cells(LastRow, 1), Cells(LastRow, 8))


 With EMail
 .To = ""
 .CC = ""
 .BCC = ""
 .Subject = "Employee Has Requested Off Work: Please See Attached for Updated Request Off Log"
 .HTMLBody = RangetoHTML(rng) _
 [HTML] & "<br><p><a href=""K:\Operations\Production Control\JeremySMaterials\RequestOffUserForm.xlsm"">Download Now</a></p>"[/HTML]
 .Display

 End With

 Set EMail = Nothing

 Set Outlook = Nothing
 End Sub


Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    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 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

    'Publish the sheet to a htm file
    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

    '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

 

[JeremyS]

Unfortunately, I haven't got any of it to work yet. I will try to replicate all of what you've done above...I think I haven't been placing the html code the right way. Thanks a lot for all of your help!!! I really appreciate. I will be sure to tell you how this iteration goes.