Userform for data entry need VBA to Email new/last row of data

[NHagedorn]

Been working on this for quite a while....

Can't seem to get it to send the entire last row.... row data is A:AJ... may have some blanks first column will always have data "Date"

Attempted to alter rondebruin.nl's Sub

Replaced this line:
VBA Code:
Set rng = Sheets("Sheet1").Range("A1:F250").SpecialCells(xlCellTypeVisible)

With this:
VBA Code:
Dim lastRow As Long
lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Set rng = Sheets("Sheet1").Range("A1:AJ" & lastRow).SpecialCells(xlCellTypeVisible)

from previous post...https://www.mrexcel.com/board/threads/excel-vba-to-outlook-select-range-lastrow.1122009/

keep getting the error "The source is not a range or the sheet is protected, please correct and try again." for if source is nothing..

I'm using a UserForm for data entry and also need to push the userform data into the excel sheet "Sheet1"

how do I combine the code so that with the click of the command button it pushes the data to the excel spread sheet, then takes the last row of data enter and emails that

Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1) = txtDate.Text
Cells(erow, 2) = txtSSRName.Text
Cells(erow, 3) = txtFRSName.Text
Cells(erow, 4) = txtContactNumber.Text
Cells(erow, 5) = ComboBox1
Cells(erow, 6) = txtPreviouslyReported.Text
Cells(erow, 7) = cboTopics
Cells(erow, 8) = cboIssues
Cells(erow, 9) = ComboBox3
Cells(erow, 10) = txtPatientID.Text
Cells(erow, 12) = ComboBox2
Cells(erow, 16) = txtPertinentDetails.Text
Cells(erow, 17) = txtOtherImportant.Text
Cells(erow, 19) = txtClaimDenial.Text
Cells(erow, 20) = txtPayer.Text
Cells(erow, 21) = txtDOS.Text
Cells(erow, 22) = txtAppealInfo.Text
Cells(erow, 23) = txtSiteName.Text
Cells(erow, 25) = txtHCPName.Text
Cells(erow, 24) = txtSiteID.Text
Cells(erow, 26) = txtSiteContact.Text
Cells(erow, 27) = txtSitePhone.Text
Cells(erow, 28) = txtBestTime.Text
Cells(erow, 29) = txtExpectations.Text

txtDate.Text = ""
txtSSRName.Text = ""
txtFRSName.Text = ""
txtContactNumber.Text = ""
ComboBox1 = ""
txtPreviouslyReported.Text = ""
cboTopics = ""
cboIssues = ""
ComboBox3 = ""
txtPatientID.Text = ""
ComboBox2 = ""
txtPertinentDetails.Text = ""
txtOtherImportant.Text = ""
txtClaimDenial.Text = ""
txtPayer.Text = ""
txtDOS.Text = ""
txtAppealInfo.Text = ""
txtSiteName.Text = ""
txtHCPName.Text = ""
txtSiteID.Text = ""
txtSiteContact.Text = ""
txtSitePhone.Text = ""
txtBestTime.Text = ""
txtExpectations.Text = ""

Application.Visible = True
Unload Me


ActiveWorkbook.Save
Application.DisplayAlerts = True






End Sub

 

[NHagedorn]

Code trying to use to send

[CODE=vba]

Private Sub cmdExit_Click()





'Working in Excel 2000-2016

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

    Dim Source As Range

    Dim Dest As Workbook

    Dim wb As Workbook

    Dim TempFilePath As String

    Dim TempFileName As String

    Dim FileExtStr As String

    Dim FileFormatNum As Long

    Dim OutApp As Object

    Dim OutMail As Object

    Dim lastRow As Long

    

 lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

    

    Set Source = Nothing

    On Error Resume Next

      

      

    Set rng = Sheets("Sheet1").Range("A1:AJ" & lastRow).SpecialCells(xlCellTypeVisible)

    On Error GoTo 0



    If Source Is Nothing Then

        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly

        Exit Sub

    End If



    With Application

        .ScreenUpdating = False

        .EnableEvents = False

    End With



    Set wb = ActiveWorkbook

    Set Dest = Workbooks.Add(xlWBATWorksheet)



    Source.Copy

    With Dest.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial Paste:=xlPasteValues

        .Cells(1).PasteSpecial Paste:=xlPasteFormats

        .Cells(1).Select

        Application.CutCopyMode = False

    End With



    TempFilePath = Environ$("temp") & "\"

    TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")



    If Val(Application.Version) < 12 Then

        'You use Excel 97-2003

        FileExtStr = ".xls": FileFormatNum = -4143

    Else

        'You use Excel 2007-2016

        FileExtStr = ".xlsx": FileFormatNum = 51

    End If



    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)



    With Dest

        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

        On Error Resume Next

        With OutMail

            .to = ""

            .CC = ""

            .BCC = ""

            .Subject = "Site ID- " & Cells(erow, 24) & "  Site Name- " & Cells(erow, 23)

            .Body = "Hi there"

            .Attachments.Add Dest.FullName

            'You can add other files also like this

            '.Attachments.Add ("C:\test.txt")

            .Display

        End With

        On Error GoTo 0

        .Close savechanges:=False

    End With



    Kill TempFilePath & TempFileName & FileExtStr



    Set OutMail = Nothing

    Set OutApp = Nothing



    With Application

        .ScreenUpdating = True

        .EnableEvents = True

    End With

End Sub

[/CODE]