Combining two workbook_change subs

[jstone4880]

I have two subs that work fine (the first one is from this forum many moons ago!)

Can anyone put them together at all as I understand there can only be one worksheet_change sub.

Also, could another behaviour (Racist behaviour) be added as an OR next to "Sexual harassment"?

I am sadly still at a very basic level with code.

Just for context - this is to track worrying behaviours in a school and a Green Form is for safeguarding concerns.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Dim c As Range
For Each c In Target
    If WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
        msg = "This is the first time this name has been entered." & vbCr & vbCr & "Are you sure it has been spelt correctly?" & vbCr & vbCr & "Last name, space, then first name."
    MsgBox msg, vbExclamation, "New Name"
    End If
Next c

 Dim xCell As Range, Rg As Range
    On Error Resume Next
    Set Rg = Application.Intersect(Target, Range("K:K"))
    If Not Rg Is Nothing Then
        For Each xCell In Rg
            If xCell.Value = "Sexual harassment" Then
                MsgBox "For this type of behaviour a Green Form needs to be filled in as well."
                Exit Sub
            End If
        Next
    End If
End Sub

 

[jstone4880]

Sorry - just realised I meant "worksheet_change"!

 

[excel_learnerz]

You can combine the two subs into one Worksheet_Change event by putting the code together. You can also add the "Racist behaviour" condition using an OR statement. Here's the combined code:

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Check for changes in column A
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Dim c As Range
    For Each c In Target
        If WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
            msg = "This is the first time this name has been entered." & vbCr & vbCr & "Are you sure it has been spelt correctly?" & vbCr & vbCr & "Last name, space, then first name."
            MsgBox msg, vbExclamation, "New Name"
        End If
    Next c

    ' Check for changes in column K
    Dim xCell As Range, Rg As Range
    On Error Resume Next
    Set Rg = Application.Intersect(Target, Range("K:K"))
    If Not Rg Is Nothing Then
        For Each xCell In Rg
            If xCell.Value = "Sexual harassment" Or xCell.Value = "Racist behaviour" Then
                MsgBox "For this type of behaviour a Green Form needs to be filled in as well."
                Exit Sub
            End If
        Next
    End If
End Sub

This code will check for changes in both column A and column K, and display the appropriate message based on the conditions specified.

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A:A")) Is Nothing Then
Dim c As Range
For Each c In Target
    If WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
        msg = "This is the first time this name has been entered." & vbCr & vbCr & "Are you sure it has been spelt correctly?" & vbCr & vbCr & "Last name, space, then first name."
    MsgBox msg, vbExclamation, "New Name"
    End If
Next c
ElseIf Not Intersect(Target, Range("K:K")) Is Nothing Then
 Dim xCell As Range, Rg As Range
    Set Rg = Intersect(Target, Range("K:K"))
    If Not Rg Is Nothing Then
        For Each xCell In Rg
            If xCell.Value = "Sexual harassment" Or xCell.Value = "Racist behaviour" Then
                MsgBox "For this type of behaviour a Green Form needs to be filled in as well."
                Exit Sub
            End If
        Next
    End If
End If
End Sub

 

[jstone4880]

Thank you for the quick replies!

Fluff's version has worked perfectly - many thanks indeed.

The first one would only work with column A.

This will really help my school - much appreciated!

 

[Fluff]

Glad we could help & thanks for the feedback.