Consulting

Results 1 to 7 of 7

Thread: How to Merge Two Worksheet_Change Codes

  1. #1
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    4
    Location

    How to Merge Two Worksheet_Change Codes

    Hi,
    I am trying to merge two VBA codes;

    Code1:

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 Then
    Target.Offset(0, 1).ClearContents
    Target.Offset(0, 2).ClearContents
    Target.Offset(0, 3).ClearContents
    Target.Offset(0, 4).ClearContents
    Target.Offset(0, 5).ClearContents
    Target.Offset(0, 6).ClearContents
    Target.Offset(0, 7).ClearContents
    Target.Offset(0, 8).ClearContents
    Target.Offset(0, 9).ClearContents
    Target.Offset(0, 10).ClearContents
    Target.Offset(0, 11).ClearContents
    End If
    End Sub



    Code2:

    Private Sub Worksheet_Change(ByVal Target As Range)
    Set xxx = Intersect(Target, Range("E2:O10000"))
    If Not xxx Is Nothing Then
    If HasValidation(xxx) Then
    Exit Sub
    Else
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbCritical
    End If
    End If
    End Sub


    Private Function HasValidation(r) As Boolean
    HasValidation = True
    'Returns True if every cell in Range r uses Data Validation
    On Error Resume Next
    For Each cll In r.Cells
    x = cll.Validation.Type
    If Err.Number <> 0 Then
    HasValidation = False
    Exit For
    End If
    Next cll
    End Function


    It looks like i have to change something but i couldn't find. Is there anyone to explain?

    Thanks!

  2. #2
    VBAX Tutor
    Joined
    Dec 2008
    Posts
    267
    Location
    Probably:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim Rng As Range
        
        Application.EnableEvents = False
        
        If Target.Column = 4 Then
            If Target.Row > 1 Then
                Target.Offset(, 1).Resize(, 11).ClearContents
            End If
        End If
        
        Set Rng = Intersect(Target, Range("E2:O10000"))
        
        If Not Rng Is Nothing Then
            If HasValidation(Rng) Then
                GoTo EndProc
            Else
                Application.Undo
                MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbExclamation
            End If
        End If
        
    EndProc:
        Application.EnableEvents = True
    End Sub
    Artik

  3. #3
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    4
    Location
    Quote Originally Posted by Artik View Post
    Probably:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim Rng As Range
        
        Application.EnableEvents = False
        
        If Target.Column = 4 Then
            If Target.Row > 1 Then
                Target.Offset(, 1).Resize(, 11).ClearContents
            End If
        End If
        
        Set Rng = Intersect(Target, Range("E2:O10000"))
        
        If Not Rng Is Nothing Then
            If HasValidation(Rng) Then
                GoTo EndProc
            Else
                Application.Undo
                MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbExclamation
            End If
        End If
        
    EndProc:
        Application.EnableEvents = True
    End Sub
    Artik
    Hi,
    Thanks for your reply. I have tried this code but it shows error alert on If HasValidation(Rng) Then and shows this message: compile error:sub or function not defined.

    How can we fix this problem?

    Thanks

  4. #4
    VBAX Tutor
    Joined
    Dec 2008
    Posts
    267
    Location
    The message clearly says that the function is missing. Then add the entire HasValidation code to the module.

    Artik

  5. #5
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    4
    Location
    Many thanks for your help. Could you please explain me how to add HasValidation code to the module? I am not an expert on VBA.

  6. #6
    VBAX Tutor
    Joined
    Dec 2008
    Posts
    267
    Location
    You have pasted the code to the module that I showed earlier. Paste the following code under it:
    Private Function HasValidation(r) As Boolean    
    
        HasValidation = True
        
        'Returns True if every cell in Range r uses Data Validation
        On Error Resume Next
        For Each cll In r.Cells
            x = cll.Validation.Type
            If Err.Number <> 0 Then
                HasValidation = False
                Exit For
            End If
        Next cll
    End Function
    Artik

  7. #7
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    4
    Location
    Thanks for your help. It works fine for a couple of time but then it shows below error for Application.Undo line

    Run time error 1004: Method Undo of object _Application failed.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •