I have a macro that puts the current time into a cell upon editing any row. my problem is that this macro also executes for row 1 which are the titles. So it ends up changing the title of a column to a time.
The macro works fine but still changes the title. I tried the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If ActiveCell.Row = 1 Then Exit Sub
Cells(Target.Row, "I").Value = Now
Application.EnableEvents = True
End Sub
The ActiveCell can change to something else after you edit, so use the Target range rather than the ActiveCell. For example, if I hit {enter} to finish my edit, the ActiveCell is now on row 2 rather than 1.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Row > 1 Then
Cells(.Row, "I").Value = Now
End If
End With
Application.EnableEvents = True
End Sub
I'm using With syntax to show the same Row you are comparing is the one you are editing. You could still put these on separate lines if you wish.
Also, user Jeeped makes a good point about the Application.EnableEvents = True line. It won't run if the row is 1, so they get turned off indefinitely. Better to test for > 1 and only run your update code on that condition.
If you turn off event handling, provide error control that makes sure that events will be re-enabled.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim r As Long, rw As Long, rng As Range, newTarget As Range
For Each rng In Target
If rng.Column <> 9 Then
If newTarget Is Nothing Then
Set newTarget = rng
Else
Set newTarget = Union(newTarget, rng)
End If
End If
Next rng
For r = 1 To newTarget.Rows.Count
rw = newTarget.Rows(r).Row
If rw > 1 Then _
Cells(rw, "I").Value = Now
Next r
Safe_Exit:
Application.EnableEvents = True
End Sub
If you are pasting or filling a large number of values then Target is all of the cells that changed. You need to guard against the top row while everything else receives the timestamp. When Target is more than a single cell, you only want to timestamp once per row.
And you don't want to turn off event handling then exit without turning it back on again.
Related
I am trying to run this worksheet change event for two different columns(A) and (I)...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("A:A")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
r.Offset(0, 1).Value = Date
Next r
Application.EnableEvents = True
End Sub
This event is something i found on this forum. Its purpose is to make it so whenever data is ever entered into column "a" it auto inputs the date into the cell directly right of it. I want this to happen twice on the worksheet. I can't figure out how to change/add to it. I am trying to get it to run the logic for column A and I on my spreadsheet.
Just expand the range you set to the A variable.
Set A = Range("A:A, I:I")
Rewritten as,
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(range("A:A, I:I"), target) is nothing then
'add error control
on error goto safe_exit
'don't do anything until you know something has to be done
dim r as range
Application.EnableEvents = False
For Each r In intersect(range("A:A, I:I"), target)
r.Offset(0, 1).Value = Date 'do you want Date or Now?
Next r
end if
safe_exit:
Application.EnableEvents = True
End Sub
edited after OP's comment
expanding on #Jeeped solution, you can avoid looping:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A:A, I:I"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub
I used to have the following code and it used to work but for some reason it no longer works.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim test As Range
Dim KeyCells As Range
Dim i As String
Set KeyCells = Range("AF3:AF5000")
test = Target.Rows.Count
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
For i = Target.Row To (Target.Row + (Target.Rows.Count - 1))
If Not ActiveSheet.Cells(i, 32) = "" Then
ActiveSheet.Cells(i, 20).Value = "Closed"
End If
Next
End If
End sub
Basically if there is data in any cells of column AF then the cell align with the information in column T would mark Closed. For example if AF65 <>"" then T65.value ="Closed"
Any idea why it no longer works or if there is another possibility for a macro?
Get rid of the redundant code and non-specific worksheet references. For example, a Worksheet_Change can be triggered when that worksheet is not the Activesheet; putting in Activesheet when it is not required only confuses the issue.
You also are not disabling events so your sub is going to try to run on top of itself.
This should be closer to what you are attempting to perform.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AF3:AF5000"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("AF3:AF5000"), Target.Parent.UsedRange)
If CBool(Len(trgt.Value2)) Then
trgt.Offset(0, -12) = "Closed"
Else
trgt.Offset(0, -12) = vbNullString
End If
Next trgt
End If
safe_exit:
Application.EnableEvents = True
End Sub
If your original sub just 'stopped working' then put Application.EnableEvents = True into the VBE's Immediate window and tap [enter]. It is possible that your earlier code crashed with event handling disabled.
I've read a few others which partially resolved my issue but being a complete VB amateur I can't get this to work. The worksheet in question is protected so have tried adding in a protect/unprotect command in the code. It will unprotect fine at the start but then encounters problems. Any help would be appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Sheet1.Unprotect Password:="mypassword"
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B11")) Is Nothing Then
Select Case Target.Value
Case Is = ""
Target.Value = "Product Name (IE Product123)"
Target.Font.ColorIndex = 15
Case Else
Target.Font.ColorIndex = 1
End Select
End If
If Not Intersect(Target, Range("B12")) Is Nothing Then
Select Case Target.Value
Case Is = ""
Target.Value = "Version "
Target.Font.ColorIndex = 15
Case Else
Target.Font.ColorIndex = 1
End Select
End If
Sheet1.Protect Password:="mypassword"
End Sub
You have not turned off the Application.EnableEvents property but there is a chance that you will write something to the worksheet. This would retrigger the event handler and the Worksheet_Change event macro would try to run on top of itself.
There is nothing preventing someone from simultaneously clearing the contents of both B11 and B12. Rather than abandoning the processing, accommodate the possibility and process both cells if there are two cells in target.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B11:B12")) Is Nothing Then
On Error GoTo bm_Safe_Exit
'turn off event handling 'cause we might write something
Application.EnableEvents = False
'why this unprotect necessary??
'Me.Unprotect Password:="mypassword"
Dim rng As Range
For Each rng In Intersect(Target, Range("B11:B12"))
Select Case rng.Value2
Case vbNullString
If rng.Address(0, 0) = "B11" Then
rng = "Product Name (IE Product123)"
Else
rng = "Version " '<~~ why the trailing space??
End If
rng.Font.ColorIndex = 15
Case Else
rng.Font.ColorIndex = 1
End Select
Next rng
End If
bm_Safe_Exit:
'if unprotect is not necessary, neither is protect
'Me.Protect Password:="mypassword"
Application.EnableEvents = True
End Sub
You might also want to look into the UserInterfaceOnly parameter of the Worksheet.Protect method. Setting this to true allows you to do anything you want in VBA without unprotecting the worksheet.
Addendumm:
If the user can alter the contents of B11:B12 then these cells must not be locked. If they are not locked then there is no need to unprotect the worksheet before (possibly) altering their contents.
I need some help with this code as it doesn't work properly.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("W:W").Column Then
Cells(.Row, "AC").Value = Int(Now)
End If
End With
Next Cell
End Sub
I am trying to get automatic static date stamps in column "AC" every time I fill in cells in column "W" and I want to start with row "19".
Tried to use
If .Column = Range("W19").End(xldown) Then
but it doesn't work.
I've just started using macro and vba and it will really help me if you can explain any solutions to me.
Thank you
Always turn off events if you are going to write to the worksheet in order that the Worksheet_Change event macro does not try to run on top of itself.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("W:W")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("W:W"))
If rng.Row > 18 Then _
rng.Offset(0, 6) = Date 'or Now for datetime
Next rng
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should handle multiple changes to column W like a block range paste.
I would like to start off with stating that I have virtually no coding experience. I found a VBA snippet online for highlighting an entire selected range (just to as a visual guide):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
I would like to also have the cursor jump-to column "J". For instance, after performing a search for cells containing the words "strawberry topping" after pressing 'OK' the cell containing that text becomes active and, due to the VBA code, the entire row is highlighted.
The first cell I need to work on is in column "J". Can I also have column J selected along with the row being highlighted?
Thank you so much for your time and would appreciate any help you may have to offer.
My Three cents
If you are using xl2007+ then do not use Target.Cells.Count. Use Target.Cells.CountLarge else you will get an Overflow error if a user tries to select all cells by pressing CTRL + A as Target.Cells.Count can't hold a Long value.
If you want to select the row and the column, you might want to switch off events else you might end up in endless loop.
Since you are working with events, use error handling.
Is this what you are trying?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rw As Long, Col As Long
Dim ColName As String
On Error GoTo Whoa
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
' Clear the color of all the cells
'Cells.Interior.ColorIndex = 0
With Target
Rw = .Row
Col = .Column
ColName = Split(Cells(, Col).Address, "$")(1)
' Highlight the entire column that contain the active cell
'.EntireRow.Interior.ColorIndex = 8
Range(ColName & ":" & ColName & "," & Rw & ":" & Rw).Select
End With
LetsContinue:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
End Sub