Using VBA Workbook_SheetChange only works in one direction - excel

I am trying to use the Workbook_SheetChange feature of excel. I want to have multiple worksheets feed information into a master worksheet, and if you update a cell in a source sheet, the corresponding cell in the master sheet will also change, and vice versa.
Currently, I am starting small with just trying to get this thing to work with one cell so I can build on this. The code I have works, but only in one direction; when I edit something in the source sheet, the cell value in the master sheet changes to that new value. However, when I try to change the value in the master sheet, the value in the master sheet kinda bounces around until it finally decides to stick to the value derived from the source sheet. This only occurs whenever I try to have the cell portion of the address be the same between the two sheets; if the target cell in Sheet1 is $A$1 and the target cell in Sheet2 is any cell that is not $A$1, then there are no issues. This issue only occurs if the cell in both sheets is the same.
Below is the code that I am currently using.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
cell_1 = Worksheets("Sheet1").Range("$R$3").Address
cell_2 = Worksheets("Sheet2").Range("$R$3").Address
If Target.Address = cell_1 Or Target.Address = cell_2 Then
Call cellUpdate(Target.Address)
End If
End Sub
Sub cellUpdate(Target As String)
cell_1 = Worksheets("Sheet1").Range("$R$3").Address
cell_2 = Worksheets("Sheet2").Range("$R$3").Address
Application.EnableEvents = False
With ActiveWorkbook
If Target = cell_1 Then
Worksheets("Sheet2").Range("$R$3").Value = Worksheets("Sheet1").Range(Target)
ElseIf Target = cell_2 Then
Worksheets("Sheet1").Range("$R$3").Value = Worksheets("Sheet2").Range(Target)
End If
End With
Application.EnableEvents = True
End Sub
How do I get around this issue? I couldn't find any information online on how to avoid this since the uses I found for this Workbook_SheetChange function are for things that occur in one sheet rather than multiple sheets.

What is happening here is that you extensively use Target.Address. The issue with this is that Target.Address only returns the cell address, not the sheet it is on. For example it would return $A$1. Not Sheet1!$A$1. This means that in your if statement it tests whether "$A$1" = "$A$1" regardless of which sheet this address is on. Therefore it will only ever run the first clause of this loop resulting in it only working one way.
Secondly, you have a lot of redundant code, hard-coding a bunch of addresses multiple times. This can be massively simplified as demonstrated below:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell_1, cell_2 As Range
Set cell_1 = Worksheets("Sheet1").Range("$R$3")
Set cell_2 = Worksheets("Sheet2").Range("$R$3")
Application.EnableEvents = False
If Target = cell_1 Then
cell_2.Value = cell_1.Value
ElseIf Target = cell_2 Then
cell_1.Value = cell_2.Value
End If
Application.EnableEvents = True
End Sub
This code uses the first and second cell as range which stores the entire cell in memory, address, values, the lot. It then switches off EnableEvents as you did (good effort by the way, to prevent yourself from getting stuck in an infinite loop as most people would with this kind of code). Then it checks whether your target cell is cell 1 and switches the value of cell two with cell one, and the same for cell 2. No need for a separate function.

Couple of observations:
Worksheets("Sheet1").Range("$R$3").Address will always return the string $R$3, as will Worksheets("Sheet2").Range("$R$3").Address.
Both lines return exactly the same thing - it doesn't care what sheet it's on.
The Call statement isn't required.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
'Address is R3 on whichever sheet you're changing.
If Target.Address = "$R$3" Then
'Figure out which sheet was changed and update as required.
Select Case Sh.Name
Case "Sheet1"
Worksheets("Sheet2").Range("R3") = Sh.Range("R3")
Case "Sheet2"
Worksheets("Sheet1").Range("R3") = Sh.Range("R3")
Case "Sheet3", "Sheet4"
'Do stuff if you're on sheet 3 or sheet 4.
Case Else
'Do stuff if you're on any other sheet.
End Select
End If
Application.EnableEvents = True
End Sub

Related

Trigger Macro only when Cell Value is Increased

its me....again. I am currently trying to have a Macro trigger whenever a specific cell increases on a specific sheet.
After many attempts I have been able to get the Macro to trigger when the cell is changed (increasing or decreasing) but I cannot figure out a way to have this Macro trigger only when the specified cell increases in value.
I have tried to use simple Worksheet_Change with an If Then statement that calls the Macro when the cell value is changed. Again I can't get this to trigger only when the cell increases. Not sure it is possible or if I am even thinking about this is in the right way.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address "Range" Then
Call MyMacro
End If
End Sub
Thank you for any help in advance. This would be really neat and save alot of manual clicking around.
Here is the functioning Macro that I want to trigger when certain text is entered into a range.
Sub Auto_Print_Yellow_Caution()
Application.ScreenUpdating = False
Sheets("Saver").Shapes("Group 6").Copy
Sheets("Main").Select
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
I already have my Workbook set up to track these words/phrases and return either a TRUE or FALSE value. If TRUE the associated Order Number is Printed into a Cell and a COUNTIFS formula is used to keep track of how many orders meet the TRUE condition. That number is then used to keep track of how many total of those orders there are. That works using the following
=IF(ISNUMBER(SEARCH("Completed",Main!G7)),TRUE)
-looks for specific word and returns TRUE
=IF(T3=TRUE,Main!A7,"")
-Returns order number
=IF(COUNTIF($U3:$U$200,"?*")<ROW(U3)-2,"",INDEX(U:U,SMALL(IF(U$2:U$200<>"",ROW(U$2:U$200)),ROWS(U$2:U3))))
-Sorts order numbers into list
=COUNTIF(T2:T135,TRUE)
-Counts number of orders
Hopefully this adds context to what I am trying to accomplish.
This will hopefully get you on the right track. As per your question it assumes this is required for a single cell only (and in this example code, that cell is B2). The trick is to store the new value, 'undo' the change, grab the old value, reverse the 'undo' by replacing the new value. Then you can test if the values are numbers and, if so, test if the new number is greater than the old number.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newValue As Variant, oldValue As Variant
If Target Is Nothing Then Exit Sub
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 2 Or Target.Row <> 2 Then Exit Sub ' example is using cell B2
Application.EnableEvents = False
newValue = Target.Value2
Application.Undo
oldValue = Target.Value2
Target.Value2 = newValue
Application.EnableEvents = True
If IsNumeric(oldValue) And IsNumeric(newValue) Then
If CDbl(newValue) > CDbl(oldValue) Then
Call MyMacro
End If
End If
End Sub
Here is some logic I can think of, you need to have a helper cell to store previous data and compare if it increased. In this sample my helper cell is B1 and the cell I want to track is A1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KCells As Range
Set KCells = Sheet10.Range("A1")' The variable KeyCells contains the cells that will
If Not Application.Intersect(KCells, Range(Target.Address)) Is Nothing Then 'cause an alert when they are changed.
If Sheet10.Range("B1").Value < Sheet10.Range("A1").Value Then
MsgBox "Replace this to call macro"
Sheet10.Range("B1").Value = Sheet10.Range("A1").Value 'this is to save the current data incase you change it later.
End If
End If
End Sub

Can a VBA function in excel be assigned to always be tied to a Range?

I have simple code that clears out the "State" cell whenever the "Payroll Country" cell changes. For example if the user selects "USA" in A6 and then selects "Arizona" in X6, then maybe later for some reason they change their mind and want to pick "CAN" for the country, the state cell will clear out.
But if someone in the future decides to insert a column before the X column, it will obviously move my State column over. Is there a way to make the VBA smarter (or make me smarter) so that the function will be tied to the "State" column rather than the specific "X" column?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub 'CountLarge handles larger ranges...
'check Target column and row...
If Target.Column = 1 And Target.Row >= 6 Then
With Target.EntireRow
'State column
.Columns("X").Value = ""
End With
End If
End Sub
You can use a named range, or you can use .Find to determine where your State column currently is. Here is an example using .Find
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub 'CountLarge handles larger ranges...
'check Target column and row...
If Target.Column = 1 And Target.Row >= 6 Then
Dim StateCol As Long
StateCol = Me.Range("1:5").Find("State", LookIn:=xlValues, LookAt:=xlPart).Column
With Target.EntireRow
'State column
.Columns(StateCol).Value = ""
End With
End If
End Sub
If you were to use a named range instead, you can define StateCol using StateCol = Me.Range("NamedRange").Column, it would be a little bit faster, since it doesn't need to search the row each time the user changes a value.
Side Note: The search range for .Find is Rows 1 to 5, but you may want to restrict or expand that range based on how you expect the data to move.
I (always) define an enum for the columns, like this
Public enum col_TableXXX 'adjust to your needs
col_ID = 1
col_PayrollCountry
col_State
end enum
enums are numbered automatically - so col_PayrollCountry equals to 2, col_State equals to 3 etc.
In case there are new columns or the order changes you only have to move the enums around or add a new enum.
(You can avoid code typing by transpose-pasting the column titels on an excel sheet and then create the code via formulas)
You can then use the enums like this:
If target.column = col_PayrollCountry then
target.entireRow.columns(col_State) = vbnullstring
End If
This is also much more "readable" than columns("X")
Culprit of this solution: you have to know that the columns changed. It is not an automatism that is based on the columns name.
There is another solution to your question (I was influenced by the short discussion with ACCtionMan regarding the enum-stuff):
If you can insert a table (insert > table) then you can use the listobject. Among a lot of other advantages you can reference the column by its name.
I assume that the table is named "tblData"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lo As ListObject
Set lo = Me.ListObjects("tblData")
If Not Intersect(Target, lo.ListColumns("Payroll Country").DataBodyRange) Is Nothing Then
'changed cell is in Payroll country column then
'take the intersection of the targets row and the State column to change the value
Intersect(Target.EntireRow, lo.ListColumns("State").DataBodyRange) = vbNullString
End If
End Sub
But I would prefer the following solution - because I like to have business logic in the event handlers.
If a collegue of you (or even you in 6 months) looks into the change-event code he/she will immediately understand what is happening here - without reading how it is done.
Option Explicit
Private m_loData As ListObject
Private Sub Worksheet_Change(ByVal target As Range)
'if target cells is not within loData we don't need to check the entry
If Intersect(target, loData.DataBodyRange) Is Nothing Then Exit Sub
If ColumnHeaderOfRange(target) = "Payroll Country" Then
resetStateColumnToEmptyValue target
End If
End Sub
Private Sub resetStateColumnToEmptyValue(c As Range)
Intersect(c.EntireRow, loData.ListColumns("State").DataBodyRange) = vbNullString
End Sub
'this could go in a general module - then add listobject as parameter
Private Function ColumnHeaderOfRange(c As Range) As String
On Error Resume Next ' in case c is outside of listobject
ColumnHeaderOfRange = Intersect(c.Cells(1, 1).EntireColumn, loData.HeaderRowRange)
On Error GoTo 0
End Function
'this could be public then you can access the table from outside the worksheet module
Private Function loData() As ListObject
If m_loData Is Nothing Then
Set m_loData = Me.ListObjects("tblData")
End If
Set loData = m_loData
End Function

How to lock cells which are automated filled

I want to lock the cell after entering a value in it. When I change the value on sheet2 A1, the value should still be locked in B2.
When I enter "3" in Sheet2 A1 the number 2 should till be there.
Here the code I already have:
Private Sub Worksheet_Change(ByVal Target As Range)
Sheet1.Unprotect "1234"
If VBA.IsEmpty(Target.Value) Then
Target.Locked = False
Else
Target.Locked = True
End If
Sheet1.Protect "1234"
End Sub
My first answer was assuming that cell Locking referred to the Range.Locked property but now I understand that was intended to refer to the cell values and preventing them from recalculating.
There are a few techniques that can be used to prevent cells from recalculating. The easiest would be to just change any formulas into a static value like:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target.Value = Target.Value
Application.EnableEvents = True
End Sub
This event will get rid of every formula after it calculates its value the first time. Every cell will just be whatever value the user enters or whatever value the formula calculates the first time.
You can limit the range that the event will operate within by using Intersect like:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OperationalArea As Range, AffectedArea As Range
Set OperationalArea = Me.Range("B2:F10")
Set AffectedArea = Intersect(Target, OperationalArea)
If Not AffectedArea Is Nothing Then
Application.EnableEvents = False
AffectedArea.Value = AffectedArea.Value
Application.EnableEvents = True
End If
End Sub
This would limit the event to only change cells within the area "B2:F10" as defined in OperationalArea.
If you don't like this idea you can try messing about with Application.Calculation but it gets very messy when you have multiple sheets or workbooks open.
When you do Worksheet.Protect, every cell is locked by default. You need to specify which cells should still be editable (not locked) after protecting the sheet. In your case, you need to specify that every cell except your chosen few are not locked.
The second important note is that Worksheet.Protect has an option UserInterfaceOnly which when true, allows macros to continue editing cells without needing to unprotect the sheet first. This means you can leave the sheet protected and just unlock or lock cells as needed.
Here is an example of how to unlock every cell except A1 on Sheet1:
Sub Example()
With Sheet1
.Protect Password:="1234", UserInterfaceOnly:=True
.Cells.Locked = False
.Cells(1, 1).Locked = True
End With
End Sub

Worksheet_Change Target.Address on specific sheet

I am trying to automatically hide/unhide rows on sheet2 when cell c9 changes on sheet1.
I have my Hide/Unhide Rows toggle all set up.
My worksheet change works when the target cell is on sheet2 but does not when I attempt to set the target cell to sheet1 (As is shown in my code below).
Module1 Code:
Sub Hide_Rows_Toggle()
Dim r As Range
For Each r In Columns(2).Cells
If r.Value = "X" Then
r.EntireRow.Hidden = True
End If
Next r
End Sub
Sheet2 Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Worksheets("Sheet1").Range("$C$9") Then
Call Hide_Rows_Toggle
End If
End Sub
In ThisWorkbook:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "Sheet1" And Target.Address = "$C$9" Then
Call Hide_Rows_Toggle
End If
End Sub
Now I'm home, and have tested the following;
You haven't qualified a Workbook or Worksheet object in your Hide_Rows_Toggle() sub. As such it is implicitly referencing the ActiveWorksheet
Per Worksheet.Columns documentation:
Using the Columns property without an object qualifier is equivalent to using ActiveSheet.Columns. If the active document isn't a worksheet, the Columns property fails.
The Worksheet_Change event is Worksheet specific, meaning, the event is triggered on each worksheet independantly - If you make a change on Sheet1 the event won't trigger on Sheet2 etc.
You should do the following:
Move your Worksheet_Change event to the module for Sheet1, where the change is happening.
Qualify your target worksheet (at least) in your Hide_Rows_Toggle Subroutine like so:
Qualify your range in your sub like so:
Sub Hide_Rows_Toggle()
Dim r As Range
For Each r In ThisWorkbook.Sheets("Sheet2").Columns(2).Cells
If r.Value = "X" Then
r.EntireRow.Hidden = True
End If
Next r
End Sub
This ensures the rows will only be hidden on Sheet2, otherwise it will always target the ActiveSheet which has to be the sheet you made the change in.
Lastly, It's a little unclear exactly what you are attempting to evaluate in your Worksheet_Change event.
Currently you are looking to see if the Target.Address is equal to the Value in Cell $C$9 on Sheet1. This is because the default member for the Range object is Value. So it will only return true if you are setting a cell reference in $C$9 to dictate which cell triggers the sub.
If you are intending to run Hide_Rows_Toggle when the value in $C$9 is changed, you will need to add the .Address property to your range - If Target.Address = Worksheets("Sheet1").Range("$C$9").Address - or - simply change it to a string to match the address like If Target.Address = "$C$9" Then.

Combining 2 vba codes over 2 different ranges into one statement

I can make one or the other of the below codes work, but need them both. The first locks cells in range upon data entry, the second inserts a date stamp when the final data entry in column D of each row is completed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("A8:D5005"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="Midnight"
xRg.Locked = True
Target.Worksheet.Protect Password:="Midnight"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("D8:D5005")
If Not Intersect(Target, rng) Is Nothing Then
Target.Offset(0, 1) = Now
Target.Offset.NumberFormat = "dd/mm/yyyy hh:mm:ss"
End If
End Sub
I'm still guessing a bit exactly what you're trying to do … but here is way to allow your users enter four data points ... and then to press button to add the data points to a protected list … and includes a time stamp.
First setup 4 data entry cells in A4 through to D4 by using the Format Cell option, make sure for these cells that Locked is unchecked on the Protection tab.
Next create a button and link the button to the following code:
Sub ButtonCode()
ActiveSheet.Unprotect Password:="A"
Range("A7:E7").Insert xlShiftDown
Range("A4:D4").Copy Range("A7:D7")
Range("E7") = Now()
Range("A7:E7").Interior.Color = rgbLightBlue
Range("A7:E7").Font.Color = rgbBlack
ActiveSheet.Protect Password:="A"
End Sub
As a once only step, protect the worksheet; my example consistently uses a password of "A". Note that your users will not need to enter the password at any time.
Once the sheet is setup, when the button is clicked, the code unlocks the sheet (allowing it to make edits), it move the existing data data down, copy the new data points to the top of the list, adds timestamp and some minimal formatting. It then re-enables protection so that the user can't overwrite the existing entries.
The screenshot below gives you an idea of what it might look like, including showing that A4:D4 need to be unlocked.
Maybe not the implementation direction you were thinking of … but the principles included in this example might work for you. All the best.
I'm not 100% sure of the structure of your worksheet, so here are the assumptions for my response. You only want the user to modify cells in the range "A8:D5005" … and somewhere on the sheet you want to record date/timestamp changes for cells changed.
So I would start by protecting the sheet by going to the Excel "Review" ribbon (not in VBA), and setting up an editable range as follows.
Before you close the dialog box, click on Protect Sheet so that the rest of the sheet is password protected.
Once you've done this … you can use something like the code below to record the date/timestamps. In this example … I record them in columns to the right of your editable range (given your editable data is only to Column D).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vIntersect As Variant
Set vIntersect = Application.Intersect(Target, Range("A8:D5005"))
If Not vIntersect Is Nothing Then
Application.EnableEvents = False
Target.Worksheet.Unprotect Password:="Midnight"
Target.Offset(0, 5) = Now
Target.Offset(0, 5).NumberFormat = "dd/mm/yyyy hh:mm:ss"
Target.Worksheet.Protect Password:="Midnight"
Application.EnableEvents = True
End If
End Sub

Resources