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.
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 have the following VBA script:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("calendar")) Is Nothing Then
[selectedCell1] = ActiveCell.Value
Application.ScreenUpdating = True
End If
End Sub
Currently, It recognizes only one cell is highlighted and returns it into the specific cell named selectedCell1.
This is my example:
If I select the cell N25 which contains the date "03/08/2017" it returns "03/08/2017" into another sheet cell named "selectedCell1".
But what I would like it to do, is realize I've selected the entire week, and then return that entire week range in cell "selectedCell1". See:
And then return 01/08/2017 - 05/08/2017 (that entire range) in cell "selecetedCell1".
Not sure how to adjust this VBA script. Help would be appreciated. Thanks.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("calendar")) Is Nothing Then
If Target.Cells.Count = 1 Then
[selectedCell1] = Target.Value
Else
[selectedCell1] = Format(Application.WorksheetFunction.Min(Target), "dd/mm/yyyy") & " - " & Format(Application.WorksheetFunction.Max(Target), "dd/mm/yyyy")
End If
Application.ScreenUpdating = 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'm trying to figure out a VBA code that will allow me to prefill a certain cell with a number when I type in "X" in a cell right next to it. I can't figure out if I should use Range, or Insert, or what.
I cannot use a button and assign a macro to it because I need to see which cells I have put an "X" into.
This is what I have so far, but it's using a button with macro assigned to it:
490 is being entered into E9 and tabs over to F9 after the macro button is clicked:
Sub eightNineSpring()
Range("E9").Select
ActiveCell.FormulaR1C1 = "490"
Range("F9").Select
End Sub
as automation put in the worksheet you need it:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Count = 1 Then
If Target.Value = "x" Then Target.Offset(0, -1).Value = 490
End If
End Sub
or as formula in E1 then copy down
=IF(F1="x",490,"")
But keep in mind when deleting the "x" (or replace it with something different):
The function will empty the 490 again while the change event will not
When using a Change Events that makes a change, Application.Events should be turned off to avoid the code calling itself recursively.
The code below caters for one or more cells in E1:E10 being updated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, Range("F1:F10"))
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rng2 In Range
If rng2.Value = "x" Then rng2.Offset(0, -1).Value = 490
Next
Application.EnableEvents = True
End Sub
The original code (Excel VBA) I found works fine for keeping track of one column:
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("P:P"), Target)
xOffsetColumn = 2
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Date
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
I want to track two columns. Below, you will find the newly added code. It does not work, even though I changed variable names after the Dim (by adding a b). Simple copy-pasting the old code and then only change the range from P:P to S:S and the xOffsetColumn also does not work.
Private Sub Worksheet_Change_b(ByVal Target As Range)
'Update 20140722
Dim WorkRngb As Range
Dim Rngb As Range
Dim xOffsetColumnb As Integer
Set WorkRngb = Intersect(Application.ActiveSheet.Range("S:S"), Target)
xOffsetColumnb = 3
If Not WorkRngb Is Nothing Then
Application.EnableEvents = False
For Each Rngb In WorkRngb
If Not VBA.IsEmpty(Rngb.Value) Then
Rngb.Offset(0, xOffsetColumnb).Value = Date
Rngb.Offset(0, xOffsetColumnb).NumberFormat = "dd-mm-yyyy"
Else
Rngb.Offset(0, xOffsetColumnb).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
This modification to your original Worksheet_Change event macro should take care of both columns including pasting multiple values into a range that encompasses one or both columns.
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20150930
If Not Intersect(Target, Union(Columns("P"), Columns("S"))) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Union(Columns("P"), Columns("S")))
If Not VBA.IsEmpty(rng) Then
rng.Offset(0, 2 - CBool(rng.Column = 19)) = Date
rng.Offset(0, 2 - CBool(rng.Column = 19)).NumberFormat = "dd-mm-yyyy"
Else
rng.Offset(0, 2 - CBool(rng.Column = 19)).ClearContents
End If
Next rng
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
To simply the offset, I simply worked back two columns from column P to column N. I'm not sure why the second event macro sample only moved back to column P; I didn't think it was your intention to overwrite the values in column P.
The Application.ActiveSheet.Range("P:P") column reference was unnecessary and potentially dangerous if the event macro was triggered by code that changed one of the values while another worksheet held the ActiveSheet property. Worksheet code pages are private by default; module code pages are public by default. You can reference cells and ranges without explicitly declaring their parent in a worksheet code sheet while that is bad coding practice on a module code sheet.
I also changed the value used for the timestamp from Date to Now. The cell formatting will still only display the date but if you ever need it, you will have the time as well.