userform errors

[rjmdc]

hi
i have a user form
somehow the delete row macro messes up the send email macro

Log Sheet.xlsm
	A	B	C	D	E	F	G	H	I
4	tom	12/27/2021	Submitted DDP1
5	jerry	January 04, 2022	Update SD Participants DPP Services
6	mark	January 04, 2022	Created Files for DDP1
Log

emails works but then when i delete row it debugs to the send email

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

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

 

[Siddharth Rout]

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?

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

If Target.Columns.Count > 1 Then

instead of

If Target.CountLarge > 1 Then

 

[rjmdc]

hi
i am confused
what am i changing?
am i correcing the send email sub?

 

[Siddharth Rout]

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

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

 

[rjmdc]

instead of my send email code and leave delete row as is?

 

[Siddharth Rout]

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)

 

[rjmdc]

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

 

[Siddharth Rout]

What error are you getting?

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

If TypeName(Selection) <> "Range" Then
    MsgBox "Select a cell in Col A."
    Exit Sub
End If

 

[rjmdc]

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

 

[Siddharth Rout]

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

If Target.CountLarge > 1 Then

by

If Target.CountLarge > 1 Then Exit Sub