userform errors

rjmdc

Well-known Member
Joined
Apr 29, 2020
Messages
672
Office Version
  1. 365
Platform
  1. Windows
hi
i have a user form
somehow the delete row macro messes up the send email macro
Log Sheet.xlsm
ABCDEFGHI
4tom12/27/2021Submitted DDP1
5jerryJanuary 04, 2022Update SD Participants DPP Services
6markJanuary 04, 2022Created Files for DDP1
Log


emails works but then when i delete row it debugs to the send email
Rich (BB code):
Sub DeleteRow()
Dim tbl     As ListObject

    If Selection.Column <> 1 Or Selection.Cells.Count <> 1 Then
        MsgBox "You must be in Column A to perform the delete function."
        Exit Sub
    End If

    If MsgBox("Are you sure you want to delete: " & Selection.Value & "?", vbYesNo + vbExclamation, "Confirm Delete") = vbNo Then
        Exit Sub
    End If
       
'    Dim tbl As ListObject
    Dim LastRow As Range
    Dim col As Long
    Set tbl = Worksheets("Log").ListObjects("Service_Log_Sheet")
    
    
'    Application.EnableEvents = False
'    tbl.AutoFilter.ShowAllData

    Dim sr As Long 'Actual Row
    Dim slr As Long 'Start List Row
    sr = Selection.Rows(1).Row
    slr = sr - Selection.ListObject.Range.Row  'The starting List Row


'    Application.EnableEvents = True

    Selection.ListObject.ListRows(slr).Delete

End Sub

Rich (BB code):
Private Sub Worksheet_Activate()
    frmLogSheet.Show
End Sub
Private Sub Worksheet_Deactivate()
    Unload frmLogSheet
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sMail As String, sSubj As String, sBody As String

  If Target.Column = 5 And Target.Value = ChrW(&H2713) Then
  
'      If MsgBox("Pressing OK will send email to notify", vbOKCancel + vbInformation, "Startup Approved") = vbOK Then
        
        'Data for MAIL 1 Column F
        sMail = "me@me"
        sSubj = Cells(Target.Row, "B").Value & " Budget Uploaded"
        sBody = "A Budget was uploaded for  " & Cells(Target.Row, "B").Value & "."
        Call SendMail(sMail, sSubj, sBody)
        
        MsgBox "Outlook messages sent", , "Outlook message sent" ' Confirm Sent Email
'      End If
    ElseIf Target.Column = 7 And Target.Value = ChrW(&H2713) Then
  
'      If MsgBox("Pressing OK will send email to notify", vbOKCancel + vbInformation, "Startup Approved") = vbOK Then
        
        'Data for MAIL 1 Column H
        sMail = "me@me"
        sSubj = Cells(Target.Row, "B").Value & " DDP1 Approved"
        sBody = "DDP1 was approved for  " & Cells(Target.Row, "B").Value & "."
        Call SendMail(sMail, sSubj, sBody)
        
        MsgBox "Outlook messages sent", , "Outlook message sent" ' Confirm Sent Email
'      End If
    End If
 End Sub

Sub SendMail(sMail, sSubj, sBody)
  Dim OutlookApp As Object
  Set OutlookApp = CreateObject("Outlook.Application").CreateItem(0)
  With OutlookApp
    .to = sMail
    .Subject = sSubj
    .Body = sBody
    .Display 'Display Email
    .Send 'Send Email
  End With
End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
The problem is when you delete the row, Worksheet_Change event is fired and because of that Target.Value will fail on Target.Value = ChrW(&H2713).

Is this what you are trying to do?

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sMail As String, sSubj As String, sBody As String
  
    '~~> Check if target consists of more than 1 cell
    If Target.CountLarge > 1 Then
        Exit Sub
        '~~> Or handle as you want it
    End If
  
    If Target.Column = 5 And Target.Value = ChrW(&H2713) Then
    '
    '~~> Rest of your code
    '
End Sub

Since it is only one row, you may also use

VBA Code:
If Target.Columns.Count > 1 Then

instead of

VBA Code:
If Target.CountLarge > 1 Then
 
Upvote 0
hi
i am confused
what am i changing?
am i correcing the send email sub?
 
Upvote 0
hi
i am confused
what am i changing?
am i correcing the send email sub?

No. You are adding the code that I shared above in Private Sub Worksheet_Change(ByVal Target As Range)

Use this instead of your code

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sMail As String, sSubj As String, sBody As String
    
    If Target.CountLarge > 1 Then
    
    If Target.Column = 5 And Target.Value = ChrW(&H2713) Then
        sMail = "me@me"
        sSubj = Cells(Target.Row, "B").Value & " Budget Uploaded"
        sBody = "A Budget was uploaded for  " & Cells(Target.Row, "B").Value & "."
        Call SendMail(sMail, sSubj, sBody)
        
        MsgBox "Outlook messages sent", , "Outlook message sent" ' Confirm Sent Email
    ElseIf Target.Column = 7 And Target.Value = ChrW(&H2713) Then
        sMail = "me@me"
        sSubj = Cells(Target.Row, "B").Value & " DDP1 Approved"
        sBody = "DDP1 was approved for  " & Cells(Target.Row, "B").Value & "."
        Call SendMail(sMail, sSubj, sBody)
        
        MsgBox "Outlook messages sent", , "Outlook message sent" ' Confirm Sent Email
    End If
End Sub
 
Upvote 0
instead of my send email code and leave delete row as is?
 
Upvote 0
instead of my send email code and leave delete row as is?

Yes leave the rest as it is. Just replace your Private Sub Worksheet_Change(ByVal Target As Range) code with my Private Sub Worksheet_Change(ByVal Target As Range)
 
Upvote 0
hi
it fails on the delete see red


Sub DeleteRow()
Dim tbl As ListObject

If Selection.Column <> 1 Or Selection.Cells.Count <> 1 Then
MsgBox "You must be in Column A to perform the delete function."
Exit Sub
End If

If MsgBox("Are you sure you want to delete: " & Selection.Value & "?", vbYesNo + vbExclamation, "Confirm Delete") = vbNo Then
Exit Sub
End If

' Call WSUnProtect(Worksheets("Bills"))

' Dim tbl As ListObject
Dim LastRow As Range
Dim col As Long
Set tbl = Worksheets("Log").ListObjects("Service_Log_Sheet")


' Application.EnableEvents = False
' tbl.AutoFilter.ShowAllData

Dim sr As Long 'Actual Row
Dim slr As Long 'Start List Row
sr = Selection.Rows(1).Row
slr = sr - Selection.ListObject.Range.Row 'The starting List Row


' Application.EnableEvents = True

Selection.ListObject.ListRows(slr).Delete

' Call WSProtect(Worksheets("Bills"))
End Sub
 
Upvote 0
What error are you getting?

Also you may want to add these lines before that line?

VBA Code:
If TypeName(Selection) <> "Range" Then
    MsgBox "Select a cell in Col A."
    Exit Sub
End If
 
Upvote 0
i am going round in circles
now it fails again at the point see red

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sMail As String, sSubj As String, sBody As String

If Target.CountLarge > 1 Then

If Target.Column = 5 And Target.Value = ChrW(&H2713) Then
sMail = "me@me"
sSubj = Cells(Target.Row, "B").Value & " Budget Uploaded"
sBody = "A Budget was uploaded for " & Cells(Target.Row, "B").Value & "."
Call SendMail(sMail, sSubj, sBody)

MsgBox "Outlook messages sent", , "Outlook message sent" ' Confirm Sent Email
ElseIf Target.Column = 7 And Target.Value = ChrW(&H2713) Then
sMail = "me@me"
sSubj = Cells(Target.Row, "B").Value & " DDP1 Approved"
sBody = "DDP1 was approved for " & Cells(Target.Row, "B").Value & "."
Call SendMail(sMail, sSubj, sBody)

MsgBox "Outlook messages sent", , "Outlook message sent" ' Confirm Sent Email
End If
End Sub
 
Upvote 0
i am going round in circles
now it fails again at the point see red

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sMail As String, sSubj As String, sBody As String

If Target.CountLarge > 1 Then

If Target.Column = 5 And Target.Value = ChrW(&H2713) Then
sMail = "me@me"
sSubj = Cells(Target.Row, "B").Value & " Budget Uploaded"
sBody = "A Budget was uploaded for " & Cells(Target.Row, "B").Value & "."
Call SendMail(sMail, sSubj, sBody)

MsgBox "Outlook messages sent", , "Outlook message sent" ' Confirm Sent Email
ElseIf Target.Column = 7 And Target.Value = ChrW(&H2713) Then
sMail = "me@me"
sSubj = Cells(Target.Row, "B").Value & " DDP1 Approved"
sBody = "DDP1 was approved for " & Cells(Target.Row, "B").Value & "."
Call SendMail(sMail, sSubj, sBody)

MsgBox "Outlook messages sent", , "Outlook message sent" ' Confirm Sent Email
End If
End Sub

Sorry that is my mistake. In that above code, replace

VBA Code:
If Target.CountLarge > 1 Then

by

VBA Code:
If Target.CountLarge > 1 Then Exit Sub
 
Upvote 0

Forum statistics

Threads
1,213,529
Messages
6,114,155
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top