I have the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$N$16" Then
Sheet3.Unprotect ""
Call QuantityisActivated(Target)
Sheet3.Protect ""
End If
End Sub
How can i use the same code for multiple Target.Adress for example, I want here from N16 to N30 range of cells
Sub QuantityisActivated(Target)
MsgBox "This is a sample box"
End Sub
The following can be used to only fire the QuantityisActivated if cells within the range are changed:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("N16:N30"))
If Not rng Is Nothing Then
'If you want it to run on each cell withing the range..
For Each c In rng.Cells
Call QuantityisActivated(c)
Next
'Or if you want it to run once, if any cell in range is affected
Call QuantityisActivated(rng)
End If
End Sub
I've included two possible ways of dealing with the affected range - either at a cell by cell level, or as an entire range as it's not clear which you'd prefer from your question.
Related
I have this code
Private Sub Worksheet-Change(ByVal Target As Range)
If Not Intersect(Target, Range(“M4”)) Is Nothing Then
Range("N4:T4).ClearContents
End If
End Sub
Which works for the 4th row When I change M4 it clears N4 to T4
I need a way to adapt this code so that if I change the value of M5 it deletes N5 to T5 and so on for all the rows.
Can you help
You need to intersect the range you want to observe for changes Me.Range("M4:M10") with Target and then use the Range.Offset property and Range.Resize property to move from the changed cell 1 right and resize it to 7 columns to clear contents.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Range("M4:M10")) 'range to observe
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange.Cells
Cell.Offset(ColumnOffset:=1).Resize(ColumnSize:=7).ClearContents
'or
'Me.Range("N" & Cell.Row & ":T" & Cell.Row).ClearContents
Next Cell
End If
End Sub
Test Target for if it contains a cell in M, and use its row to clear the relevant cells
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl as Range
For Each cl In Intersect(Target, Me.Columns(13))
If cl.Row >= 4 Then
cl.EntireRow.Cells(1, 14).Resize(1, 7).ClearContents
End If
Next
End Sub
I want to activate a macro on a change in a range.
The following code works fine except I want a variable last row (Where B100 currently is).
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1:B100")) Is Nothing Then
MsgBox "Updating sheets"
Call Thickborders2
End If
End Sub
The B100 in the range is dependent on the last row with text in it.
You can borrow a worksheet trick to find the last row with text in it.
=MATCH("zzz", B:B)
The above returns the last row in column B with a text value.
Private Sub Worksheet_Change(ByVal Target As Range)
dim m as variant
m = application.match("zzz", columns("B"))
if iserror(m) then m = 1
If Not Intersect(Target, Range("B1").resize(m, 1)) Is Nothing Then
MsgBox "Updating sheets"
Call Thickborders2
End If
End Sub
I strongly recommend adding error control (on error goto <label>) and disabling event triggers (application.enableevents = false). Remember to re-enable events before exiting the sub.
As I said in my comment on the OP - Worksheet_Change on its own won't work as it will calculate the last cell based on the data just entered.
This code calculates the last cell when you move cells (I tried on the Calculate event but that happens after you've added the data so same problem as the Change event).
Option Explicit
Private rLastCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set rLastCell = Cells(Rows.Count, 2).End(xlUp)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range(Cells(1, 2), rLastCell)) Is Nothing Then
MsgBox "Updating sheets"
Call Thickborders2
End If
End Sub
The first two lines must be at the very top of the module.
Building on comments from Taazar and L42 try:
Private Sub Worksheet_Change(ByVal Target As Range)
LastCell = Activesheet.Usedrange.Rows.Count
If Not Intersect(Target, Range("B1:B" & LastCell)) Is Nothing Then
MsgBox "Updating sheets"
Call Thickborders2
End If
End Sub
Where Activesheet should be replaced by the sheetname you're checking.
So i am currently using a classic "Run macro if Cell changes value":
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("O1"), Range(Target.Address)) Is Nothing Then
Call Macro A
End if
End Sub
Now i want to extend the macro so it checks every cell in the range Range("O1:O40"), and run a different macro depending on which cell that changes value.
The different macros could be placed in a loop, as the code is essentially:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("O1"), Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N1").Value = Worksheets("Input").Range("O1").Value
ElseIf Not Application.Intersect(Range("O2"), Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N2").Value = Worksheets("Input").Range("O2").Value
End if
End Sub
so if Worksheets("Input").Range("O1") changes value, the value must be copied to Worksheets("Data").Range("N1"), and so forth for all the cells in range "O1:O40"
You can run through the range using a For Each Loop
Dim cell As Range
For Each cell In Range("O1:O40")
If Not Application.Intersect(cell, Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N" & cell.row).Value2 = cell.Value2
End If
Next cell
I am using the code below to fire a macro on the click of a cell. The cell in question is a header "Mitch's Macro" but it on merged cells B5 through J5. I have tried naming this merged range to MITCH, but it still doesnt run on click... Any ideas? Thank you in advance!
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("MITCH")) Is Nothing Then
MsgBox ("Hello World")
End If
End If
End Sub
The problem is Selection.Count = 1.
The merged cells have more than one cells so once you select any cell in the merged area, the code doesn't get executed.
Please give this a try...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("MITCH")) Is Nothing Then
MsgBox ("Hello World")
End If
End Sub
Edit:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Range("MITCH")
If Target.CountLarge > rng.Cells.Count Then Exit Sub
If Not Intersect(Target, rng) Is Nothing And Target.Cells(1).Address = rng.Cells(1).Address Then
MsgBox ("Hello World")
End If
End Sub
After a little more thinking I realised that most answers have a few drawbacks, and I think this is what we're really after:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Range("MITCH")
If Target.Address = rng.MergeArea.Address Then 'check if what's selected matches the named range entirely
MsgBox ("Hello World")
End If
End Sub
As this checks whether the cells you have selected perfectly map onto the named area - specifically the MergeArea of the named range.
Matching with Intersect just checks if the selection contains the named Range
Matching by TL cell means any selection with the same TL as the named Range will also return a positive. E.g, if [B2:D3] is your merged named range, then matching by [B2] will return positive if [B2:D3] is selected (as expected), but also when [B2:XX100] is selected
This code only returns positive when the areas are identical, i.e. only the merged cell is selected.
If you have named the range you could use the code below
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tName As String
On Error Resume Next
tName = Target.Name.Name
On Error GoTo 0
If Len(tName) > 0 Then
If tName = "MITCH" Then
MsgBox ("Hello World")
End If
End If
End Sub
Ran in to a little problem. If I try to paste to multiple cells that are in the range in the code below, I get a run time error 13, type mismatch. The cells in the range may have data other than X but I only want the hyperlink to appear if the cell contains X. It works fine if I just type an X in the cell or if I paste to one cell at a time. I will have times when I want to paste other text to mutiple cells in this range. Thanks to Remnant for his help on the original code. This one last hurdle will put me in the clear. Thx.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rangeLimit As Range
Set rangeLimit = Range
("B9:B37,C9:C37,D9:D37,E9:E37,F9:F37,G9:G37,H9:H37,I9:I37,J9:J37,K9:K37,L9:L37,M9:M37")
If Not Intersect(rangeLimit, Target) Is Nothing Then
If Target = "x" Or Target = "X" Then
Target.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:="Exceptions!A1",
TextToDisplay:=Target.Value
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rangeLimit As Range
dim c as range
Set rangeLimit = Range("B9:M37")
If Not Intersect(rangeLimit, Target) Is Nothing Then
for each c in Intersect(rangeLimit, Target)
If c.value = "x" Then
c.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:="Exceptions!A1", TextToDisplay:=c.Value
End If
next c
End If
End Sub
When you paste in a range, 'Target' is a set of cells - not just one cell. If you know this code works for one cell, you can loop over all of the cells in the range target, and call the If statement on each of the cells.
Try this modification to the original code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rangeLimit As Range
Dim cl As Range
Set rangeLimit = Range("B9:B37,C9:C37,D9:D37,E9:E37,F9:F37,G9:G37,H9:H37,I9:I37,J9:J37,K9:K37,L9:L37,M9:M37")
If Not Intersect(rangeLimit, Target) Is Nothing Then
For Each cl In Target
If cl = "x" Or cl = "X" Then
cl.Hyperlinks.Add Anchor:=cl, Address:="", SubAddress:="Exceptions!A1", TextToDisplay:=cl.Value
End If
Next cl
End If
End Sub