When I enter a value in Sheet 2 D1, the number should be entered in the table like if-statement and after that, the statement should disappear and the value should be still entered in the cell.
Table:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OperationalArea As Range, AffectedArea As Range
Set OperationalArea = Me.Range("B2:G7")
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
The event WorkSheet_Change() will not trigger if the change is caused only by recalculation.
You can use an event in Sheet2 instead:
' Event in Sheet2
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Me.Range("D1")) Is Nothing Then
' Change "Sheet1" to the name of the sheet with the table in B2:G7
ThisWorkbook.Worksheets("Sheet1").Range("B2:G7") = Me.Range("D1")
End If
End Sub
Related
I need help automatically changing cells containing a certain value whenever a specific cell on same row changes value.
E.g whenever a cell in B column changes = change TRUE to FALSE on that specific row.
My VBA knowledge is pretty much nonexistent and Im certainly a beginner.
Im fairly sure that Worksheet.Change is what Im looking for and I've been trying out some code I've found here on SO, such as:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
For Each x In Target
Cells(x.Row, 3).Value = "False"
Next
End Sub
I know though that this doesn't replace specific values in whatever column the cells are.
I've been trying out silly things like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
For Each x In Target
If Cells(x.Row, x.Column).Value = "TRUE" Then Value = "FALSE"
Next
End Sub
But of course it doesnt work.
Think you could point me out a direction of what I should be researching?
Replace the change event sub on the sheet where you have your data with the code below. I think that should do the trick
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oRng As Range
Dim oCell As Range
' Check if change was in column B
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
' Turn off events so that when we make a change on the sheet, this event is not triggered again
Application.EnableEvents = False
' Set the range to include all column in Target row
Set oRng = Target.Parent.Range("C" & Target.Row & ":" & Target.Parent.Cells(Target.Row, Target.Parent.UsedRange.Columns.Count).Address)
' Loop through all cells to change the value
For Each oCell In oRng
If Trim(LCase(oCell.Value)) = "true" Then
oCell.Value = "FALSE"
End If
Next
' Enable events again
Application.EnableEvents = True
End Sub
I have rows from 1-100.
I know how to target specific cells and get data from them, but how would I do this when any row from 1 to 100 can be changed?
Say you put anything into Row A3. How would you write "Updated" into row B3 via VBA?
I want this to apply to rows A1-A100.
Thanks
Place the following event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, Intersection As Range, Cell As Range
Set A = Range("A1:A100")
Set Intersection = Intersect(Target, A)
If Intersection Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Cell In Intersection
Cell.Offset(0, 1).Value = "Updated"
Next Cell
Application.EnableEvents = True
End Sub
Open VBA Editor
Double click on the sheet you event take action (sheets appears in the left top box)
Select Worksheet on the left box above code box
Select change on the right box above code box
Paste the code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.Worksheets("Sheet1")
If Not Intersect(Target, .Range("A1:A100")) Is Nothing Then
Application.EnableEvents = False
.Range("B" & Target.Row).Value = "Updated"
Application.EnableEvents = True
End If
End With
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.
I have a table of values that I need to fill out through a worksheet change function.
What I am trying to do is change a cell in columns B-G, depending on where the target is.
Private Sub Worksheet_Change(ByVal Target As Range)
If (Not Intersect(Target, Range(Cells(12, 2), Cells(14, 7))) Is Nothing) Then
Cells(16,Application.WorksheetFunction.Column(Target))="Hello"
End If
End Sub
I have similar bits of code in the same worksheet_change sub that work fine when I use Target.Offset(1,0) but since my possible target range is in more than 1 Row, I don't know how to make it so that it is always row 16 and the same column as the target....
You need to deal with situations where Target is more than a single cell and disable event handling so when you change a value on the worksheet, the Worksheet_Change doesn't try to run on top of itself.
This will put 'hello' into the cell immediately to the right of any cell within B:G that changes; essentially you would be adding 'hello' to columns C:H on the associated row of each cell in Target.
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(target, Range(Cells(12, "B"), Cells(14, "G"))) is nothing then
on error goto safe_exit
application.enableevents = false
dim t as range
for each t in intersect(target, Range(Cells(12, "B"), Cells(14, "G")))
t.Offset(1,0) = "hello"
next t
End If
safe_exit:
application.enableevents = true
End Sub
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