CODEWITHSUNDEEP
vbaexcelexcel-formula
Tmacjoshua
Tmacjoshua

Reputation: 87

Have more than one Worksheet_Change in a Worksheet

I am looking to limit my workbook users to 1000 characters over a range of cells (Example: A5:A30).

In other words limit the total characters in the range A5:A30 to 1000 characters.

When a user fills in a cell that sends the range over the 1000 character limit, it will call Application.undo which should just remove the last text that they added.

However since I have another Private Sub Worksheet_Change(ByVal Targe As Range) on the worksheet, it causes a bug.

Below is both Worksheet_Change subs. Both use the same cells.

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim charCount As Long

    If Not Intersect(Target, Range("E6,E11,E16")) Is Nothing Then

        Dim arrValues As Variant
        arrValues = Range("E6,E11,E16").Value2

        Dim i As Long
        Dim tempSplit As Variant
        Dim j As Long

            For i = LBound(arrValues) To UBound(arrValues)
             tempSplit = Split(arrValues(i, 1), " ")

            For j = LBound(tempSplit) To UBound(tempSplit)
                charCount = charCount + Len(tempSplit(j))
            Next j
        Next i

    End If

If charCount > 1000 Then
   Application.Undo
    MsgBox "Adding this exceeds the 1000 character limit"
 End If


            If Not Intersect(Target, Range("D6")) Is Nothing Then

        If Target.Value2 = "Material" Then
        'assumes the comment cell is one column to the right
            Target.Offset(0, 1) = "**"
        End If

    End If

            If Not Intersect(Target, Range("D7")) Is Nothing Then

        If Target.Value2 = "Material" Then
        'assumes the comment cell is one column to the right
            Target.Offset(-1, 1) = "**"
        End If

        End If

       If Not Intersect(Target, Range("D8")) Is Nothing Then

        If Target.Value2 = "Material" Then
           Target.Offset(-2, 1) = "**"
        End If

    End If
End Sub

Is there a way around this so I can have two Worksheet_Change on the same worksheet?

Upvotes: 1

Views: 2396

Answers (2)

Vityata
Vityata

Reputation: 43593

You cannot have two Worksheeet_Change events in one sheet. But, one is quite enough:

Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case True
    Case Not Intersect(ActiveCell, Range("A5:A30")) Is Nothing
        DoThingOne
    Case Not Intersect(ActiveCell, Range("B5:B30")) Is Nothing
        DoThingTwo
    End Select

End Sub

Private Sub DoThingOne()
    Debug.Print "THING ONE"
End Sub

Private Sub DoThingTwo()
    Debug.Print "THING TWO"
End Sub

Upvotes: 3

Marcucciboy2
Marcucciboy2

Reputation: 3257

How about this revision using Vityata's idea?

Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case True

        Case Not Intersect(Target, Range("E6,E11,E16")) Is Nothing

            Dim charCount As Long

            Dim arrValues As Variant
            arrValues = Range("E6,E11,E16").Value2

            Dim i As Long
            Dim tempSplit As Variant
            Dim j As Long

            For i = LBound(arrValues) To UBound(arrValues)
                tempSplit = Split(arrValues(i, 1), " ")

                For j = LBound(tempSplit) To UBound(tempSplit)
                    charCount = charCount + Len(tempSplit(j))
                Next j
            Next i

            If charCount > 1000 Then
                With Application
                    .EnableEvents = False
                    .Undo
                    .EnableEvents = True
                End With

                MsgBox "Adding this exceeds the 1000 character limit"
            End If

        Case Not Intersect(Target, Range("D6")) Is Nothing

            If Target.Value2 = "Material" Then
                'assumes the comment cell is one column to the right
                Target.Offset(0, 1) = "**"
            End If

        Case Not Intersect(Target, Range("D7")) Is Nothing

            If Target.Value2 = "Material" Then
                'assumes the comment cell is one column to the right
                Target.Offset(-1, 1) = "**"
            End If

        Case Not Intersect(Target, Range("D8")) Is Nothing

            If Target.Value2 = "Material" Then
                Target.Offset(-2, 1) = "**"
            End If

    End Select

End Sub

Upvotes: 0

Related Questions