I am trying to track data in a laboratory.
Goal. When the value in cell P3 changes to "yes", then cells Q3:AE3 are locked. However, if "yes" does not appear in cell P3, then cells Q3:AE3 are unlocked.
I need to loop through column P locking/unlocking cells with respect to the row each P value is located.
For example if P36 = "Yes", the Q36:AE36 would become locked.
Edit: This code works with line P3. How can I make this loop through P3:P500?
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("P3") = "Yes" Then
Range("Q3:AE3").Locked = True
ElseIf Range("P3") = "No" Then
Range("Q3:AE3").Locked = False
ElseIf Range("P3") = "" Then
Range("Q3:AE3").Locked = False
End If
End Sub
This will handle any number of values being changed in column P. Provide your password as needed.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'did any cells in column P change
If Not Intersect(Target, Me.Range("P1").EntireColumn) Is Nothing Then
Me.Unprotect "password"
Dim cell As Range
For Each cell In Intersect(Target, Me.Range("P1").EntireColumn)
Me.Range("Q" & cell.Row & ":AE" & cell.Row).Locked = UCase$(cell.Value) = "YES"
Next
Me.Protect "password"
End If
End Sub
Related
I'm currently working on a sheet that has to automatically insert todays date in a cell, if another cell is = "Yes"
I currently have this line of code (that I found online):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("G:G")) Is Nothing Then
Application.EnableEvents = False
For Each cell In Target
cell.Offset(0, 4).Value = Now
cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
Next cell
End If
Application.EnableEvents = True
End Sub
The problem is that the updated cell in row K is being updated every time the cell is changed, and it should only be updated when the cell in row G = "Yes"
I appreciate the help :)
Your basic problem is solved easily - just add an If to check the content of the cell:
For Each cell In Target
If UCase(cell.Value2) = "YES" Then
cell.Offset(0, 4).Value = Now
cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
Next cell
Next cell
However, your check for column 'G' is flawed. Target contains all cells that are currently modified. If the user enter something into a cell, Target will contain exactly that cell. If, however, data is for example pasted into that sheet, Target will contain all cells where data is pasted into.
Now, Intersect checks if two ranges have common cells. Your statement If Not Intersect(Target, Range("G:G")) Is Nothing will check if any of the modified cells is in column G and if yes, it will write the date into the cell that is 4 columns to the right. In the case the user enter something into a cell of column G, that's okay. But if he pastes something into, let's say, cells of columns F,G,H, the code will run for all three cells. So you should check each cell individually.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo change_exit ' Ensure that events are re-enabled in case of error
Application.EnableEvents = False
Dim cell As Range
For Each cell In Intersect(Target, Range("G:G"))
If UCase(cell.Value2) = "YES" Then
cell.Offset(0, 4).Value = Now
cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
end if
Next cell
change_exit:
Application.EnableEvents = True
End Sub
Update: Changed the logic by just looping over the cells of target that intersect with column G - thanks to BigBen for the hint.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("G:G")) Is Nothing Then
Application.EnableEvents = False
For Each cell In Target
If cell.Value = "Yes" Then
cell.Offset(0, 4).Value = Now
cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
End If
Next cell
End If
Application.EnableEvents = True
End Sub
We test the value of each entry!
I have a cell which i declared as active cell using developers tool in excel
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("C1").Value = ActiveCell.Value
End Sub
this cell is equals to the value of a drop down cell i created from data validation.
My Problem is cell C1 is not changing when i select a new value from the drop down
Here you go. When B1 is changed C1 is assigned the value of B1. It doesn't matter how the change was carried out, from the keyboard or by selection from a drop-down.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("B1").Address Then
' prevent the coming change from causing a call of this procedure
Application.EnableEvents = False
Cells(1, "C").Value = Target.Value
Application.EnableEvents = True
End If
End Sub
Is there a way in excel (VBA) to mark any change in a row (A2-A10) for example with an identifier if any cell in that row is changed. So for if A2 changes, add an X in A1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("A2:A10")) Is Nothing And Target <> "" Then '<- If there is any change in area A2:A10 and the value of the affect cell IS NOT empty then
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value = "X"
ElseIf Not Intersect(Target, Range("A2:A10")) Is Nothing And Target = "" Then '<- If there is any change in area A2:A10 and the value of the affect cell IS empty then
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value = ""
End If
Application.EnableEvents = True
End Sub
You can have a macro function to change the value or add new value when anything changes in the source cell.
This macro will be on the rows where the change needs to be recorded.
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
Hope someone can answer us.
We want to do the following:
When a value is entered in A1, this value is added to the value of B1.
We then want the value of A1 too reset to 0, but keep the value of B1
Is this possible in excel?
On the worksheet's VBA private module (right-click the report tab and hit "View Code"), enter the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = Range("a1").Address Then
Range("b1") = Range("b1") + Range("a1")
Range("a1").ClearContents
End If
Application.EnableEvents = True
End Sub
Worksheet_Change is called whenever a change is made to the worksheet.
Application.EnableEvents=False prevents the code from running continuously (without it, the change to B1 would also call Worksheet_change).
This code assumes that the value in B1 is always numeric (or blank). If it may contain character text, then a check will need to be put in place to either reset its value or not do the increment.
Using simoco's suggestion:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1 As Range
Set A1 = Range("A1")
If Intersect(Target, A1) Is Nothing Then
Else
Application.EnableEvents = False
With A1
.Offset(0, 1) = .Offset(0, 1) + .Value
.ClearContents
End With
Application.EnableEvents = True
End If
End Sub