Excel Link two cells in different sheets using when changed macro - vba

I have an Excel workbook with multiple worksheets. I have a cell in WORKSHEET A with range name TRACK1 and a cell in WORKSHEET B with range name TRACK2.
Each TRACK1 and TRACK2 are validated from a list. The user can change either cell from the drop-down list shown when the cell is selected.
I want to be able to allow the user to change either and have the other be also changed to match. Change value of TRACK1 and TRACK2 is changed, and vice versa.
I know how to do this basic macro, but how to stop the event propagating?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("TRACK1")) Is Nothing Then
Range("TRACK2") = Range("TRACK1")
End If
If Not Application.Intersect(Target, Range("TRACK2")) Is Nothing Then
Range("TRACK1") = Range("TRACK2")
End If
End Sub

In worksheet A's code module, use:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("TRACK1")) Is Nothing Then
Worksheets("WORKSHEET B").Range("TRACK2") = Range("TRACK1")
End If
Application.EnableEvents = True
End Sub
In worksheet B's code module, use:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("TRACK2")) Is Nothing Then
Worksheets("WORKSHEET A").Range("TRACK1") = Range("TRACK2")
End If
Application.EnableEvents = True
End Sub

Related

Type Mismatch error when range of data is changed in Excel

I have written a macro to color my cells green if the input is TRUE and red if the input to cell is FALSE.
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Name = "Ribs" Then
If Not Intersect(Target, Range("G2:K200")) Is Nothing Then
If Target = "False" Then
Sheets("Ribs").Range(Target.Address).Style = "Bad"
ElseIf IsNumeric(Target) Then
Sheets("Ribs").Range(Target.Address).Style = "Good"
End If
ElseIf Not Intersect(Target, Range("D2:D200")) Is Nothing Then
RotateRib (Target.Address)
End If
End If
End Sub
Now the problem is that if I change the range value (for example typing TRUE in cell G2 and than drag mouse pointer from bottom right corner of G2 to G10 should copy value TRUE to range G2:G10) raises Type Mismatch error in my macro.
Debugger says the problematic line is If Target = "False" Then.
Is there a workaround the given error? Ignoring the error would probably do the job, but it's not something I'd like to do.
The problem is that you're trying to do an illegal operation. You're asking the compiler to see if the contents of G2:G10 is equal to False - you can see this by adding Debug.Print Target.Address to the top of your code and then making another attempt.
It is possible to do what you want, but you'll need more code. When comparing values, you have to do it cell by cell - you can't compare an entire range at once. Here's a rudimentary example:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If ActiveSheet.Name = "Ribs" Then
For Each c In Target
If Not Intersect(c, Range("G2:K200")) Is Nothing Then
If c.Value = "False" Then
Sheets("Ribs").Range(c.Address).Style = "Bad"
ElseIf IsNumeric(c.Value) Then
Sheets("Ribs").Range(c.Address).Style = "Good"
End If
ElseIf Not Intersect(c, Range("D2:D200")) Is Nothing Then
RotateRib (c.Address)
End If
Next c
End If
End Sub
The principal change is that we're no longer comparing against Target, we're looping through all the individual cell contents (Range objects denoted as c) of Target and comparing against those.
Again, you can verify that this works by trying this code and filling down some values:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Target
Debug.Print c.Address
Next c
End Sub
There's absolutely no need to check the name of active sheet, since Worksheet_Change event fires on the sheet where it's defined.
Rather iterating over each cell in the Target, you could receive the intersection and apply your settings directly.
Don't forget about that Target can contain non-contiguous ranges (accessed by Areas property). My code handles this situation, but can't say the same about RotateRib.
To sum up:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngIntersect As Range, rngArea As Range, cell As Range
Set rngIntersect = Intersect(Target, Range("G2:K200"))
If Not rngIntersect Is Nothing Then
For Each rngArea In rngIntersect.Areas
For Each cell In rngArea
cell.Style = IIf(cell, "Good", "Bad")
Next
Next
End If
Set rngIntersect = Intersect(Target, Range("D2:D200"))
If Not rngIntersect Is Nothing Then RotateRib (rngIntersect)
End Sub

Can't change value of cell with code in a protected sheet

I have a password protected sheet, with some unlocked cells that user can chage.
Once the user changes any value, it automatically should make changes to other unlocked cells by vba code. This works fine if the sheet is unlocked, but not if it's protected.
example of code:
In Workbook_Open() I set UserInterfaceOnly attribute to TRUE:
Sheets("Sheet Name").Protect Password:="123456", UserInterFaceOnly:=True, Contents:=True
Sheet code: Set date.01 value into date.02 cell if date.01 changes
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Worksheets("Sheet Name").Range("date.02") = Target
End If
End Sub
cells "date.01" and "date.02" are unlocked.
Why can't I update them?
EDIT:
Is SelectionChange event the best option to change cell values? And is it ok to do the assignment like this:
Worksheets("Sheet Name").Range("date.02") = Target
I can see that the changes are applieD when the original cell get the focus back.
What I really want to do is to give a group of cells in different sheets the same value anytime any of them are changed by the user.
SOLVED.
My bad, I was using
Worksheet_SelectionChange
instead of
Worksheet_Change
I also had to use this to prevent any errors.
Application.EnableEvents = False
<CODE>
Application.EnableEvents = True
There was no need of using UserInterfaceOnly as all cells/ranges are unlocked.
you can simply check it's something to do with protection.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Sheets("Sheet Name").unProtect Password:="123456"
`Worksheets("Sheet Name").Range("date.02") = Target`
`Sheets("Sheet Name").Protect Password:="123456", UserInterFaceOnly:=True`
End if
End Sub
Do you apply validation through VBA
The event method to use is Worksheet.Change Event
https://msdn.microsoft.com/en-us/library/office/ff839775.aspx
And the code was like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Application.EnableEvents = False
Worksheets("Sheet1").Range("date.01") = Target
Worksheets("Sheet2").Range("date.02") = Target
Worksheets("Sheet3").Range("date.03") = Target
Worksheets("Sheet4").Range("date.04") = Target
Worksheets("Sheet5").Range("date.05") = Target
Application.EnableEvents = True
End If
End Sub

VBA - autoupdate filter in excel after entering data

I'm fairly new to VBA and have been trying to get my spreadsheets to do a little more than just pivot tables allow. I've been able to set up some autofilters in excel using VBA, but now I'd like to have the worksheet autofilter after I enter data into a cell. However, neither of the two lines below work after I press enter.
Here are the two various lines of code I've tried:
1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$5" Then
Application.EnableEvents = False
FilterTo1Critera
Application.EnableEvents = True
End If
End Sub
2
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cel As Range
Set ws = ThisWorkbook.Sheets("Sheet3")
If Not Intersect(Target, Range("A3")) Is Nothing Then
For Each cel In Target
Range("A3").Value = "Changed"
Application.EnableEvents = False
If IsEmpty(ws.Range("A")) Then Sheet1.Range("A").Value = 0
Application.EnableEvents = True
Next cel
End If
End Sub
What's the correct approach to take? Also, is there some good classes that I can take to brush up on some of these concepts??
Thanks in advance!

Multiple cell value change to trigger macros

I have different set of values in cells G3:G4 and D15:D10000 in a single sheet. I want run two separate codes when G columns or D columns are changed. How I can identify which set of columns are changed?
out this in your worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G3:G4")) Is Nothing Then
'code when some cell in range "G3:G4" is changed
ElseIf Not Intersect(Target, Range("D15:D10000")) Is Nothing Then
'code when some cell in range "D15:D10000" is changed
End If
End Sub
Put the code below in your relevant worksheet, in the Worksheet_Change event.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Application.Union(Range("G3:G4"), Range("D15:D10000"))
Set IntersectRange = Intersect(Target, WatchRange)
If Not IntersectRange Is Nothing Then
Select Case Target.Column
Case 4 ' column D
Call A
Case 7 ' column G
Call B
End Select
End If
End Sub
Below are examples of Sub A and Sub B:
Sub A()
MsgBox "Running Sub A"
End Sub
Sub B()
MsgBox "Running Sub B"
End Sub

Show value of specific cell in Excel macro

I am new to excel macro.
What I need to to is by clicking on specific cell in A column I will know It`s value. Can you help me with this?
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("D1:D200")) Is Nothing Then
MsgBox Range.("D" & Row_No).Value
End If
End If
End Sub
Use the code below to check the value of any cell in Column A once you click on it, this code should be added to your relevant Sheet to Worksheet_SelectionChange event :
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
' setting Column A as watched Range
Set WatchRange = Range("A:A")
Set IntersectRange = Intersect(Target, WatchRange)
If Not IntersectRange Is Nothing Then
If Selection.Count = 1 Then
MsgBox Target.Value
Else
MsgBox "You have selected more than 1 cell !"
End If
End If
End Sub