Combine Private Sub Worksheet_Change

newgirl · Oct 11th 2021

Hello!

I'm new to VBA. How can I combine 2 worksheet change commands? I tried to do it as such below but only the first portion works.

Basically, what I want is that when user inputs "56765201 MEALS" or "56855753 ENTERTAINMENT EXPENSES" or "56855777 MEETINGS" under column D, a msgbox will pop up (the message would depend on the input.

And then in Column F, if the date they input is more than 90 days from current date, then a MsgBox should appear.

Hope somebody can help me out!

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim EmpNames$
    
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    

    If Target.Value = "56765201 MEALS" Then
        MsgBox "Reminder that the allowed total daily reimbursable meals is P1,500.", vbOKOnly + vbInformation, "56765201 MEALS"
    End If
    
    If Target.Value = "56855753 ENTERTAINMENT EXPENSES" Then
    MsgBox "The names, company names of your companions, and business reason MUST be provided.", vbOKOnly + vbExclamation, "56855753 ENTERTAINMENT EXPENSES"
    Load FRMNames
    FRMNames.Show
    End If
    
    If Target.Value = "56855777 MEETINGS" Then
    MsgBox "Names of companion and business reason MUST be provided. The MOST SENIOR RANKING in the group is required to reimburse.", vbOKOnly + vbExclamation, "56855777 MEETINGS"
    Load FRMNames
    FRMNames.Show
    End If
    
    '************************** (1) Add >90 day prompt
    '**************************New sheet value change command
    Dim K As Date
    Dim firstDate As Date, secDate As Date, n As Integer

    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Target.Column <> 6 Then Exit Sub
    
    K = Date

    firstDate = DateValue(Target.Value)
    secondDate = DateValue(K)

    n = DateDiff("d", firstDate, secondDate)

    If n > 90 Then
    MsgBox n
    End If
    
    

End Sub

Display More

**royUK** · Oct 11th 2021

Try this, note your check for Column 5 will always stop the code because you have already determined that the cell must be in Column 4.

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim EmpNames$
    
    With Target
        If .Column <> 4 Or .Value = "" Or .CountLarge > 1 Then Exit Sub
        
        
        
        
        Select Case .Value
            Case "56765201 MEALS"
                MsgBox "Reminder that the allowed total daily reimbursable meals is P1,500.", vbOKOnly + vbInformation, "56765201 MEALS"
            Case "56855753 ENTERTAINMENT EXPENSES"
                MsgBox "The names, company names of your companions, and business reason MUST be provided.", vbOKOnly + vbExclamation, "56855753 ENTERTAINMENT EXPENSES"
                Load FRMNames
                FRMNames.Show
            Case "56855777 MEETINGS"
                MsgBox "Names of companion and business reason MUST be provided. The MOST SENIOR RANKING in the group is required to reimburse.", vbOKOnly + vbExclamation, "56855777 MEETINGS"
                Load FRMNames
                FRMNames.Show
        End Select
        
        '************************** (1) Add >90 day prompt
        '**************************New sheet value change command
    Dim K As Date
    Dim firstDate As Date, secDate As Date, n As Integer
        
        ''///target column is 4 so this will always finish here
'        If Target.Column <> 6 Then Exit Sub
        
        K = Date
        
        firstDate = DateValue(Target.Offset(, 2).Value)
        secondDate = DateValue(K)
        
        n = DateDiff("d", firstDate, secondDate)
        
        If n > 90 Then
            MsgBox n
        End If
        
End Sub

Display More

Also, you have not declared all your variables.

newgirl · Oct 11th 2021

Hello @royUK ! I applied your suggestion but when I was trying it, this message showed up. I then typed "End With" between the last 'End If' and the last 'End Sub', thinking it would prevent the message. However, when I try inputting the values under Column D or a date that is more than 90 days in Column F, nothing happens.

**royUK** · Oct 11th 2021

Code amended

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim EmpNames$
    
    With Target
        If .Column <> 4 Or .Value = "" Or .CountLarge > 1 Then Exit Sub
        
        
        
        
        Select Case .Value
            Case "56765201 MEALS"
                MsgBox "Reminder that the allowed total daily reimbursable meals is P1,500.", vbOKOnly + vbInformation, "56765201 MEALS"
            Case "56855753 ENTERTAINMENT EXPENSES"
                MsgBox "The names, company names of your companions, and business reason MUST be provided.", vbOKOnly + vbExclamation, "56855753 ENTERTAINMENT EXPENSES"
                '                Load FRMNames
                '                FRMNames.Show
            Case "56855777 MEETINGS"
                MsgBox "Names of companion and business reason MUST be provided. The MOST SENIOR RANKING in the group is required to reimburse.", vbOKOnly + vbExclamation, "56855777 MEETINGS"
                '                Load FRMNames
                '                FRMNames.Show
        End Select
        
        '************************** (1) Add >90 day prompt
        '**************************New sheet value change command
    Dim K As Date
    Dim firstDate As Date, secDate As Date, n As Integer
        
        ''///target column is 4 so this will always finish here
        '        If Target.Column <> 6 Then Exit Sub
        
        K = Date
        
        firstDate = DateValue(.Offset(, 2).Value)
        secondDate = DateValue(K)
        n = DateDiff("d", firstDate, secondDate)
        If n > 90 Then MsgBox n
        
    End With
End Sub

Display More

newgirl · Oct 12th 2021

Hi royUK! I tried your 2nd suggestion but it is still not according to what I need. I made some tweaks with your code and below is the final one I made. Thank you so much for your help!

Code

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim EmpNames$
 
 With Target
 If Target.Cells.Count > 1 Then Exit Sub
 If Target.Value = "" Then Exit Sub
 If Target.Column = 4 Then
 

 Select Case .Value
 Case "56765201 MEALS"
 MsgBox "Reminder that the allowed total daily reimbursable meals is P1,500.", vbOKOnly + vbInformation, "56765201 MEALS"
 Case "56855753 ENTERTAINMENT EXPENSES"
 MsgBox "The names, company names of your companions, and business reason MUST be provided.", vbOKOnly + vbExclamation, "56855753 ENTERTAINMENT EXPENSES"
 Load FRMNames
 FRMNames.Show
 Case "56855777 MEETINGS"
 MsgBox "Names of companion and business reason MUST be provided. The MOST SENIOR RANKING in the group is required to reimburse.", vbOKOnly + vbExclamation, "56855777 MEETINGS"
 Load FRMNames
 FRMNames.Show
 End Select
 
 End If

 
 '************************** (1) Add >90 day prompt
 '**************************New sheet value change command
 
If Target.Column = 6 Then
 Dim K As Date
 Dim firstDate As Date, secDate As Date, n As Integer
 
 ''///target column is 4 so this will always finish here
 ' If Target.Column <> 6 Then Exit Sub
 'getting error if date input in Column 6 is not a date
 
 K = Date
 
 firstDate = DateValue(Target.Value)
 secondDate = DateValue(K)
 n = DateDiff("d", firstDate, secondDate)
 If n > 90 Then MsgBox "Date of receipt should NOT be more than 90 days." & vbCrLf & vbCrLf & "The date of receipt entered is " & n & " days before the current date.", vbOKOnly + vbExclamation, "Date of Receipt"
 End If
 
 End With
End Sub

Display More

**royUK** · Oct 12th 2021

I can't see how the last part of your code can work.

At the start you check if the Column is 4, then later check if it is 6. Since the active cell does not appear to move this will never be true, unless the userform changes the active cell, which in my code would be unnecessary.

You've completely messed up the With Statement.

You've split the IF statement back to 3 statements and not bothered using CountLarge which prevents an overflow error occurring - see CountLarge

Combine Private Sub Worksheet_Change

Participate now!

Share

Tags