VBA double Worksheet_Change

Zelo93

New Member
Joined
Jan 25, 2022
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
Hello guys, I'm new here and also with the use of VBA. I started last week to build my code and it goes well until now. Basically, I write two separate codes and I want to run all of them in the same sheet but when I try to combinate VBA says that there is an ambiguous name detected. How can I solve this?
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
   Set KeyCells = Range("I14:I270")

   If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

    ' Display a message when one of the designated cells has been changed.
    ' MsgBox "Cell " & Target.Address & " has changed."
   
      If ActiveCell.Value = "OFFLOADED" Then
        ActiveCell.Offset(0, 4).Range("A1").Select
        ActiveCell.FormulaR1C1 = Now
        Selection.NumberFormat = "dd-mm-yyyy"
        ActiveCell.Offset(0, -4).Range("A1").Select
      End If
   
      If ActiveCell.Value = "REQUESTED" Then
        ActiveCell.Offset(0, -7).Range("A1").Select
        ActiveCell.FormulaR1C1 = Now
        Selection.NumberFormat = "dd-mm-yyyy"
        ActiveCell.Offset(0, 7).Range("A1").Select
      End If
     
      If ActiveCell.Value = "LOADED" Then
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = Now
        Selection.NumberFormat = "dd-mm-yyyy"
        ActiveCell.Offset(0, -1).Range("A1").Select
      End If
     
       If ActiveCell.Value = "REQUESTED" Then
        ActiveCell.Offset(0, -6).Range("A1").Select
        If ActiveCell.FormulaR1C1 = "" Then                       ' Check if cell is empty
          MsgBox "Hey, normally when they request a pile, we receive the ID pile number, check on your email if you have one and make sure you will add before continuing.", vbCritical, "Check"
        End If
        ActiveCell.Offset(0, 6).Range("A1").Select
      End If
     
      If ActiveCell.Value = "OFFLOADED" Then
        ActiveCell.Offset(0, -6).Range("A1").Select
        If ActiveCell.FormulaR1C1 = "" Then                       ' Check if cell is empty
          MsgBox "Hey, that is strange. No pile request. Please add ID pile.", vbCritical, "Check"
        End If
        ActiveCell.Offset(0, 6).Range("A1").Select
      End If
     
      If ActiveCell.Value = "OFFLOADED" Then
        ActiveCell.Offset(0, -7).Range("A1").Select
        If ActiveCell.FormulaR1C1 = "" Then                       ' Check if cell is empty
          MsgBox "Be careful, this is not a right sequence. You can not OFFLOAD a pile that is not even requested.", vbCritical, "Check"
        End If
        ActiveCell.Offset(0, 7).Range("A1").Select
      End If
     
      If ActiveCell.Value = "OFFLOADED" Then
        ActiveCell.Offset(0, 1).Range("A1").Select
        If ActiveCell.FormulaR1C1 = "" Then                       ' Check if cell is empty
          MsgBox "Be sure, your pile is not loaded yet. Select LOADED and then you can continue.", vbCritical, "Check"
        End If
        ActiveCell.Offset(0, -1).Range("A1").Select
      End If
     
      If ActiveCell.Value = "LOADED" Then
        ActiveCell.Offset(0, -6).Range("A1").Select
        If ActiveCell.FormulaR1C1 = "" Then                       ' Check if cell is empty
          MsgBox "Hey, that is strange. No pile request. Please add ID pile.", vbCritical, "Check"
        End If
        ActiveCell.Offset(0, 6).Range("A1").Select
      End If
     
   If ActiveCell.Value = "LOADED" Then
        ActiveCell.Offset(0, -7).Range("A1").Select
        If ActiveCell.FormulaR1C1 = "" Then                       ' Check if cell is empty
          MsgBox "Don't be to excited. You missed the requested date, select REQUESTED and then you can LOAD your pile.", vbCritical, "Check"
        End If
        ActiveCell.Offset(0, 7).Range("A1").Select
    End If
   
   End If
     
End Sub
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)



Dim KeyCells As Range



' The variable KeyCells contains the cells that will

' cause an alert when they are changed.

Set KeyCells = Range("O20:O255")



If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then



Application.ScreenUpdating = Folse



If ActiveCell.Value = "LOCK" Then

ActiveCell.Offset(0, -2).Range("A1").Select

ActiveSheet.Unprotect

Selection.Locked = True

Selection.FormulaHidden = False

Sheets("PILE MATRIX TRACKING LIST").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:= _

True

End If



If ActiveCell.Value = "LOCK" Then

ActiveCell.Offset(0, -3).Range("A1").Select

ActiveSheet.Unprotect

Selection.Locked = True

Selection.FormulaHidden = False

Sheets("PILE MATRIX TRACKING LIST").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:= _

True

End If

If ActiveCell.Value = "LOCK" Then

ActiveCell.Offset(0, -5).Range("A1").Select

ActiveSheet.Unprotect

Selection.Locked = True

Selection.FormulaHidden = False

Sheets("PILE MATRIX TRACKING LIST").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:= _

True

End If

If ActiveCell.Value = "LOCK" Then

ActiveCell.Offset(0, -6).Range("A1").Select

ActiveSheet.Unprotect

Selection.Locked = True

Selection.FormulaHidden = False

Sheets("PILE MATRIX TRACKING LIST").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:= _

True

End If

If ActiveCell.Value = "LOCK" Then

ActiveCell.Offset(0, -12).Range("A1").Select

ActiveSheet.Unprotect

Selection.Locked = True

Selection.FormulaHidden = False

Sheets("PILE MATRIX TRACKING LIST").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:= _

True

End If

If ActiveCell.Value = "LOCK" Then

ActiveCell.Offset(0, -13).Range("A1").Select

ActiveSheet.Unprotect

Selection.Locked = True

Selection.FormulaHidden = False

Sheets("PILE MATRIX TRACKING LIST").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:= _

True



End If



Application.ScreenUpdating = True



End If



End Sub
 
Last edited by a moderator:

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

rollis13

Well-known Member
Joined
Jul 30, 2012
Messages
854
Office Version
  1. 2016
Platform
  1. Windows
Just merged and a few changes I marked.
VBA Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim ActiveTarget As Range                     '<-added (needed because Target changed along the macro)
    Set ActiveTarget = Target                     '<-added
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("I14:I270")
    If Not Application.Intersect(KeyCells, Range(ActiveTarget.Address)) Is Nothing Then '<- changed
        ' Display a message when one of the designated cells has been changed.
        ' MsgBox "Cell " & Target.Address & " has changed."
        If ActiveCell.Value = "OFFLOADED" Then
            ActiveCell.Offset(0, 4).Range("A1").Select
            ActiveCell.FormulaR1C1 = Now
            Selection.NumberFormat = "dd-mm-yyyy"
            ActiveCell.Offset(0, -4).Range("A1").Select
        End If
        If ActiveCell.Value = "REQUESTED" Then
            ActiveCell.Offset(0, -7).Range("A1").Select
            ActiveCell.FormulaR1C1 = Now
            Selection.NumberFormat = "dd-mm-yyyy"
            ActiveCell.Offset(0, 7).Range("A1").Select
        End If
        If ActiveCell.Value = "LOADED" Then
            ActiveCell.Offset(0, 1).Range("A1").Select
            ActiveCell.FormulaR1C1 = Now
            Selection.NumberFormat = "dd-mm-yyyy"
            ActiveCell.Offset(0, -1).Range("A1").Select
        End If
        If ActiveCell.Value = "REQUESTED" Then
            ActiveCell.Offset(0, -6).Range("A1").Select
            If ActiveCell.FormulaR1C1 = "" Then   ' Check if cell is empty
                MsgBox "Hey, normally when they request a pile, we receive the ID pile number, check on your email if you have one and make sure you will add before continuing.", vbCritical, "Check"
            End If
            ActiveCell.Offset(0, 6).Range("A1").Select
        End If
        If ActiveCell.Value = "OFFLOADED" Then
            ActiveCell.Offset(0, -6).Range("A1").Select
            If ActiveCell.FormulaR1C1 = "" Then   ' Check if cell is empty
                MsgBox "Hey, that is strange. No pile request. Please add ID pile.", vbCritical, "Check"
            End If
            ActiveCell.Offset(0, 6).Range("A1").Select
        End If
        If ActiveCell.Value = "OFFLOADED" Then
            ActiveCell.Offset(0, -7).Range("A1").Select
            If ActiveCell.FormulaR1C1 = "" Then   ' Check if cell is empty
                MsgBox "Be careful, this is not a right sequence. You can not OFFLOAD a pile that is not even requested.", vbCritical, "Check"
            End If
            ActiveCell.Offset(0, 7).Range("A1").Select
        End If
        If ActiveCell.Value = "OFFLOADED" Then
            ActiveCell.Offset(0, 1).Range("A1").Select
            If ActiveCell.FormulaR1C1 = "" Then   ' Check if cell is empty
                MsgBox "Be sure, your pile is not loaded yet. Select LOADED and then you can continue.", vbCritical, "Check"
            End If
            ActiveCell.Offset(0, -1).Range("A1").Select
        End If
        If ActiveCell.Value = "LOADED" Then
            ActiveCell.Offset(0, -6).Range("A1").Select
            If ActiveCell.FormulaR1C1 = "" Then   ' Check if cell is empty
                MsgBox "Hey, that is strange. No pile request. Please add ID pile.", vbCritical, "Check"
            End If
            ActiveCell.Offset(0, 6).Range("A1").Select
        End If
        If ActiveCell.Value = "LOADED" Then
            ActiveCell.Offset(0, -7).Range("A1").Select
            If ActiveCell.FormulaR1C1 = "" Then   ' Check if cell is empty
                MsgBox "Don't be to excited. You missed the requested date, select REQUESTED and then you can LOAD your pile.", vbCritical, "Check"
            End If
            ActiveCell.Offset(0, 7).Range("A1").Select
        End If
    End If
    '------- not needed anymore ---------
    'End Sub
    'Private Sub Worksheet_Change(ByVal Target As Range)
    '    Dim KeyCells As Range
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    '------------------------------------
    Set KeyCells = Range("O20:O255")
    If Not Application.Intersect(KeyCells, Range(ActiveTarget.Address)) Is Nothing Then '<- changed
        Application.ScreenUpdating = False
        If ActiveCell.Value = "LOCK" Then
            ActiveCell.Offset(0, -2).Range("A1").Select
            ActiveSheet.Unprotect
            Selection.Locked = True
            Selection.FormulaHidden = False
            Sheets("PILE MATRIX TRACKING LIST").Select
            ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                                False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
        End If
        If ActiveCell.Value = "LOCK" Then
            ActiveCell.Offset(0, -3).Range("A1").Select
            ActiveSheet.Unprotect
            Selection.Locked = True
            Selection.FormulaHidden = False
            Sheets("PILE MATRIX TRACKING LIST").Select
            ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                                False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
        End If
        If ActiveCell.Value = "LOCK" Then
            ActiveCell.Offset(0, -5).Range("A1").Select
            ActiveSheet.Unprotect
            Selection.Locked = True
            Selection.FormulaHidden = False
            Sheets("PILE MATRIX TRACKING LIST").Select
            ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                                False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
        End If
        If ActiveCell.Value = "LOCK" Then
            ActiveCell.Offset(0, -6).Range("A1").Select
            ActiveSheet.Unprotect
            Selection.Locked = True
            Selection.FormulaHidden = False
            Sheets("PILE MATRIX TRACKING LIST").Select
            ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                                False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
        End If
        If ActiveCell.Value = "LOCK" Then
            ActiveCell.Offset(0, -12).Range("A1").Select
            ActiveSheet.Unprotect
            Selection.Locked = True
            Selection.FormulaHidden = False
            Sheets("PILE MATRIX TRACKING LIST").Select
            ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                                False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
        End If
        If ActiveCell.Value = "LOCK" Then
            ActiveCell.Offset(0, -13).Range("A1").Select
            ActiveSheet.Unprotect
            Selection.Locked = True
            Selection.FormulaHidden = False
            Sheets("PILE MATRIX TRACKING LIST").Select
            ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                                False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
        End If
        Application.ScreenUpdating = True
    End If
End Sub
 
Solution

Zelo93

New Member
Joined
Jan 25, 2022
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
This work perfectly, thank you very much :)
 

rollis13

Well-known Member
Joined
Jul 30, 2012
Messages
854
Office Version
  1. 2016
Platform
  1. Windows
Glad having been of some help(y).
 

btc3111

New Member
Joined
Feb 1, 2022
Messages
6
Office Version
  1. 2021
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Is there anyway these 3 vba codes can be together on the same worksheet? I'm trying to incorporate only certain characters in certain ranges and also make said ranges only possible to be Capital letters.

VBA Code:
Private Const FCheckRgAddress As String = "M12:CI36"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xChanged As Range
    Dim xRg As Range
    Dim xString As String
    Dim sErrors As String
    Dim xRegExp As Variant
    Dim xHasErr As Boolean
    Set xChanged = Application.Intersect(Range(FCheckRgAddress), Target)
    If xChanged Is Nothing Then Exit Sub
    Set xRegExp = CreateObject("VBScript.RegExp")
    xRegExp.Global = True
    xRegExp.IgnoreCase = True
    xRegExp.Pattern = "[^A,B,C,F,I,N,O,P,S,T,X]"
    For Each xRg In xChanged
        If xRegExp.TEST(xRg.Value) Then
            xHasErr = True
            Application.EnableEvents = False
            xRg.ClearContents
            Application.EnableEvents = True
        End If
    Next
    If xHasErr Then MsgBox "These cells had invalid entries and have been cleared:"
End Sub

[CODE=vba]
Private Const FCheckRgAddress As String = "L45:T60,W45:AE60,AH45:AP60"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xChanged As Range
    Dim xRg As Range
    Dim xString As String
    Dim sErrors As String
    Dim xRegExp As Variant
    Dim xHasErr As Boolean
    Set xChanged = Application.Intersect(Range(FCheckRgAddress), Target)
    If xChanged Is Nothing Then Exit Sub
    Set xRegExp = CreateObject("VBScript.RegExp")
    xRegExp.Global = True
    xRegExp.IgnoreCase = True
    xRegExp.Pattern = "[^A,B,C,I,N,O,T,X]"
    For Each xRg In xChanged
        If xRegExp.TEST(xRg.Value) Then
            xHasErr = True
            Application.EnableEvents = False
            xRg.ClearContents
            Application.EnableEvents = True
        End If
    Next
    If xHasErr Then MsgBox "These cells had invalid entries and have been cleared:"
End Sub
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Target, Range("M12:CI36,L45:T60,W45:AE60,AH45:AP60")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub


Glad having been of some help(y).
 

rollis13

Well-known Member
Joined
Jul 30, 2012
Messages
854
Office Version
  1. 2016
Platform
  1. Windows
Should be how you need it, please test it.
Then you still need to fix your issue with multi-selected cells. If you need help on this you better start a new thread with appropriated title, even now you shouldn't have used this thread.
VBA Code:
Option Explicit
Private Const FCheckRgAddress As String = "M12:CI36"
Private Const FCheckRgAddress_2 As String = "L45:T60,W45:AE60,AH45:AP60"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xChanged As Range
    Dim xRg    As Range
    Dim xString As String
    Dim sErrors As String
    Dim xRegExp As Variant
    Dim xHasErr As Boolean
    Set xRegExp = CreateObject("VBScript.RegExp")
    xRegExp.Global = True
    xRegExp.IgnoreCase = True
    Set xChanged = Application.Intersect(Range(FCheckRgAddress), Target)
    If xChanged Is Nothing Then GoTo second
    xRegExp.Pattern = "[^A,B,C,F,I,N,O,P,S,T,X]"
    For Each xRg In xChanged
        If xRegExp.TEST(xRg.Value) Then
            xHasErr = True
            Application.EnableEvents = False
            xRg.ClearContents
            Application.EnableEvents = True
        End If
    Next
    If xHasErr Then MsgBox "These cells had invalid entries and have been cleared:"
second:
    Set xChanged = Application.Intersect(Range(FCheckRgAddress_2), Target)
    If xChanged Is Nothing Then GoTo third
    xRegExp.Pattern = "[^A,B,C,I,N,O,T,X]"
    For Each xRg In xChanged
        If xRegExp.TEST(xRg.Value) Then
            xHasErr = True
            Application.EnableEvents = False
            xRg.ClearContents
            Application.EnableEvents = True
        End If
    Next
    If xHasErr Then MsgBox "These cells had invalid entries and have been cleared:"
third:
    If Not (Application.Intersect(Target, Range("M12:CI36,L45:T60,W45:AE60,AH45:AP60")) Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub
 
Last edited:

btc3111

New Member
Joined
Feb 1, 2022
Messages
6
Office Version
  1. 2021
  2. 2016
Platform
  1. Windows
I'm sorry, should have read the rules before signing up but thank you for your help. Anyway the code works but comes with a new issue. I'll be sure to post in a new thread now
Should be how you need it, please test it.
Then you still need to fix your issue with multi-selected cells. If you need help on this you better start a new thread with appropriated title, even now you shouldn't have used this thread.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,298
Messages
5,853,136
Members
431,549
Latest member
NnAa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top