so i have a sheet and whenever something in the range of A10:A23 is changed/updated, it is supposed to put a timestamp in the according column in Row B, however it isnt working and i have no idea why.
I already set the sheets code to "Worksheet" and "change"
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = A And Target.Column >= 10 And Target.Column <= 23 Then
Cells(Target.Column, B) = Now()
End If
End Sub
Thanks in advance!
Assuming you will only change one cell at a time (which is not always true):
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A10:A23")) Is Nothing Then
If Target.Count = 1 Then
Application.EnableEvents = False
Target.Offset(0, 1) = Now()
Application.EnableEvents = True
End If
End If
End Sub
Related
I'm trying to introduce Checkboxes into my personal project Planning, unfortunately normal Checkboxes tend to bug out, so I found this side here and am trying to convert it into a macro to select the rows I want checks at. Specifically the last one that is NOT "Mutually Exclusive" but with data validation.
http://www.vbaexpress.com/kb/getarticle.php?kb_id=879
Unfortunately it does not let me make it into a macro like I wanted to and I spent a lot of time trying already. :(
Please Help
I tried to write a SelectionRng. Or searched for a way to write it into a Macro to select it in the Worksheet.
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Target.Interior.ColorIndex = 44
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets target Value = ""
Target.Interior.ColorIndex = 0
Cancel = True
Exit Sub
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Select a specific subset of the range "Ckboxes"
Select Case Target.Address
Case Else
'Populate the cell to the right of Target with its status
If Target.Value = "a" Then
Target.Offset(0, 6) = "Checked"
Else:
Target.Offset(0, 6).Value = "Not Checked"
End If
End Select
End Sub
There is a drop down list in "L18" with days "1d, 2d, 3d ...etc.". This block of code is checking, if I change the value from the drop down list and calculates it or if the appropriate selection is made in the range "Q15:Q28" (so in the column right of this cell).
Simply it should check if there is a change in the cell "L18" or the range "Q15:Q28" and triggers changing value in the range right from "Q15:Q28" But it only works if I make a change in the range "Q15:Q28". What am I missing? If I change the value in the drop down list in "L18" nothing happens.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Me.Range("I2")) Is Nothing Then
Company_selection
End If
Dim Res As Variant
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("L18:L22, Q15:Q28")) Is Nothing Then
Res = Evaluate("INDEX(N18:N24,MATCH(" & Target.Address & ",J18:J24,0))")
If Not IsError(Res) Then Target.Offset(, 1) = Res
End If
End Sub
Table PrtScn
Nuficek,
I simplified your code to the part giving you the problem, inserted a dropdown in L18 and it worked. As did making changes anywhere in the two ranges.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("L18:L22, Q15:Q28")) Is Nothing Then
MsgBox "Fired"
End If
End Sub
So it would appear that the problem is not with the item firing but rather what you do later. You might want to insert a MsgBox in your code to test out this theory.
HTH
Nuficek,
You might want to try copying the dropdown value to a another cell say one column left or right of the dropdown.
The user could change their values there also. Then you just adjust your formulas to use those cells and also include them in a third Intersect statement.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("L18:L22")) Is Nothing Then
MsgBox "Fired1"
Target.Offset(0, -1).Value = Target.Value '**Copy one column left
End If
If Not Intersect(Target, Range("Q15:Q28")) Is Nothing Then
MsgBox "Fired2"
Target.Offset(0, -1).Value = Target.Value
End If
End Sub
Don't know why you changed the L18:L22 to N18:N22 should have been left at column L. See comments in code.
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("L18:L22")) Is Nothing Then
MsgBox "Fired1"
Target.Offset(0, 1).Value = Target.Value '**Copy one column left (J)
End If
If Not Intersect(Target, Range("Q15:Q28")) Is Nothing Then
MsgBox "Fired2"
Target.Offset(0, -1).Value = Target.Value '**Copy one column left (P)
End If
Dim Res As Variant
' If Target.CountLarge > 1 Then Exit Sub (Redundant already done above)
If Not Intersect(Target, Range("N18:N24, P15:P28")) Is Nothing Then
Res = Evaluate("INDEX(O18:O24,MATCH(" & Target.Address & ",J18:J24,0))")
'*** Don't know about the ranges above but may need double checking...
If Not IsError(Res) Then Target.Offset(, 1) = Res
End If
I tried to edit the code with help of RetiredGeek but doesn't work either:
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("N18:N22")) Is Nothing Then
MsgBox "Fired1"
Target.Offset(0, 1).Value = Target.Value '**Copy one column left
End If
If Not Intersect(Target, Range("Q15:Q28")) Is Nothing Then
MsgBox "Fired2"
Target.Offset(0, -1).Value = Target.Value
End If
Dim Res As Variant
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("N18:N24, P15:P28")) Is Nothing Then
Res = Evaluate("INDEX(O18:O24,MATCH(" & Target.Address & ",J18:J24,0))")
If Not IsError(Res) Then Target.Offset(, 1) = Res
End If
I am trying to stop duplicate entries in several columns, from a drop down list. I have it working for the first column, but when I try and add a range for columns C2:C9, D2:D9 and E2:E9 I get errors. This is the code I have for B2:B9, can anyone tell me how to add more ranges? Each column uses the same list for entries. It is a simple list of numbers 1 to 8. I want each column to be able to score 1 to 8, without duplicating the score in the individual column.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B9")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If WorksheetFunction.CountIf(Range("B2:B9"), Target) > 1 Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Duplicate score. Please select a different value."
End If
End Sub
Thank you
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range(Cells(2, Target.Column), Cells(9, Target.Column))) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If WorksheetFunction.CountIf(Range(Cells(2, Target.Column), Cells(9, Target.Column)), Target) > 1 Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Duplicate score. Please select a different value."
End If
End Sub
It will work for any column in rows 2:9.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Range("B2:E9")
If Intersect(Target, r) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If WorksheetFunction.CountIf(r, Target) > 1 Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Duplicate score. Please select a different value."
End If
End Sub
The code would be slightly different if the columns were disjoint.
When the value in B16 is "0", I need to hide some other rows, and also un-hide them when the value is "1".
But, here's my issue:
Also, in the same sheet:
If the value in H4 is "0", I need to hide some rows. When the value is "1", I need to un-hide these rows.
The first part is working:
Private Sub Worksheet_Change(ByVal Target As Range)
With Sheets("Checklist")
If Range("b16").Value = 0 Then rows("17:21").EntireRow.Hidden = True
If Range("b16").Value >= 1 Then rows("17:21").EntireRow.Hidden = False
End With
End Sub
And here's where I understand I suck at VB
In other words, the code below is clearly not working. Can you please provide a working alternative?
Private Sub Worksheet_Change(ByVal Target As Range)
With Sheets("Checklist")
Select Case Taget.Address
Case "$b$16"
If IsNumeric(Target.Value) And Target.Value = 0 Then
rows("17:21").EntireRow.Hidden = True
End If
Case "$b$16"
If IsNumeric(Target.Value) And Target.Value = 0 Then
rows("17:21").EntireRow.Hidden = False
End If
Case "$h$4"
If IsNumeric(Target.Value) And Target.Value = 1 Then
rows("23:26").EntireRow.Hidden = True
End If
Case "$h$4"
If IsNumeric(Target.Value) And Target.Value = 1 Then
rows("23:26").EntireRow.Hidden = False
End If
End Select
End Sub
Thanks.
I am very novice at this, I need to apply the below to rows with VBA, can anyone advise please.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A59")) Is Nothing Then
Range("B59:E59").ClearContents
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B59")) Is Nothing Then
Range("C59:E59").ClearContents
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C59")) Is Nothing Then
Range("D59:E59").ClearContents
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("D59")) Is Nothing Then
Range("E59").ClearContents
End If
End With
I have five dependent dropdown list columns each one is dependent of the previous. I am trying to reset the cells once the previous column selection is changed. The above works fine but I do not know how to apply it to all rows or up to 10000 rows for example.
I would very much appreciate the guidance on this
Many thanks
G
If you don't want to use a loop, you can try something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row = 59 then
If not IsEmpty(Target) then
Range(Cells(59,Target.Column +1),Cells(59,"E")).ClearContents
End If
End If
End Sub
Try this one:
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Cells.Count > 1 Then Exit Sub
If .Row >= 59 And .Row <= 10000 _
And .Column <= 4 Then
Range(Cells(.Row, .Column + 1), Cells(.Row, 5)).ClearContents
End If
End With
End Sub