VBA double Worksheet_Change

Z

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

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
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
 
Upvote 0
Solution
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


rollis13 said:
Glad having been of some help(y).
Click to expand...
 
Upvote 0
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:
Upvote 0
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
rollis13 said:
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.
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
ActiveCell vs Active range search
Replies
3
Views
226
Joe4
Joe4
W
  • Question
VBA InputBox without entry quitting Sub/Macro
Replies
1
Views
111
Micron
M
J
  • Question
VBA Code to Add Rows is slowing down
Replies
5
Views
508
JayB0730
J
E
  • Solved
Macro to run anytime a ActiveX checkbox is used (no linked cells)
Replies
8
Views
346
John_w
J
D
  • Solved
Auto Date Stamp
Replies
3
Views
401
Joe4
Joe4

Forum statistics

Threads
1,214,971
Messages
6,122,517
Members
449,088
Latest member
RandomExceller01

Share this page

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
Back
Top