In My sheet when I update Cells in D column the Cell in C column will show date of update , now I need if I delete the info in D cell to Delete the info in C cell not as formula as VBA code
Code below :
`Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 4 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
With Target.Offset(0, -1)
.Value = Now
.NumberFormat = " MM/DD/YY hh:mm Am/PM"
End With
Dim RangeA As Range
Set RangeA = Range("D10:D10000")
If Application.CountBlank(RangeA) = RangeA.Cells.Count Then
Range("C10:C10000").ClearContents
End If
End Sub`
I would recommend adding an if-statement to support your activities, such that:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 4 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value <> "" then
With Target.Offset(0, -1)
.Value = Now
.NumberFormat = " MM/DD/YY hh:mm Am/PM"
End With
Else
Target.Offset(,-1).ClearContents
End If
End Sub
Related
I have this function now in Excel VBA:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Address = Cells(1, 5).Address Then
Cells(1, 6) = Application.UserName
Cells(1, 7) = Now
Else
Debug.Print "This was not B1"
End If
End Sub
this works perfect for one cell on one line. Now I need to have it for multiple lines on this sheet. How do I do that? When just copying and updating the parameters in the Cells lines I get the error message that the eventname cannot be used twice.
Final solution for me would be that for all 15 lines on in this sheet I have this function.
You can only have one SelectionChange event per worksheet, so you need to handle everything in that event.
If you want to do different things use:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge <> 1 Then Exit Sub
If Target.Address = Cells(1, 5).Address Then
Cells(1, 6) = Application.UserName
Cells(1, 7) = Now
ElseIf Target.Address = … your other cell address … Then
'do something else
Else
Debug.Print "This was not B1"
End If
End Sub
If you want to do the same thing for multiple lines the do the following:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge <> 1 Then Exit Sub
If Not Intersect(Target, Me.Range(Me.Cells(1, 5), Me.Cells(10, 5))) Is Nothing Then
Target.Offset(ColumnOffset:=1) = Application.UserName
Target.Offset(ColumnOffset:=2) = Now
Else
Debug.Print "This was not B1"
End If
End Sub
This will work from row 1 Me.Cells(1, 5) to row 10 Me.Cells(10, 5) and will write the username to column 6 and time to column 7 of the selected row of column 5 in that range.
I would like to create a sheet where I have rows that get a timestamp in the column next to it, if the content in the cell changes.
What do I do wrong in the following macro? The first macro works on its own, but not if I add several macros.
Sub Update01()
Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
With Target.Offset(0, 1)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
End With
End Sub
Sub Update02()
If Target.Column <> 3 Then Exit Sub
If Target.Cells.Count > 3 Then Exit Sub
With Target.Offset(0, 3)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
End With
End
Sub Main()
Call Update01
Call Update02
End Sub
You probably meant to do something like the following
Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error Goto ENABLE_EVENTS
Application.EnableEvents = False
If Target.Column = 1 Then
With Target.Offset(0, 1)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
End With
ElseIf Target.Column = 3
With Target.Offset(0, 3)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
End With
End If
ENABLE_EVENTS:
Application.EnableEvents = True
End Sub
Note that you need to Application.EnableEvents = False before writing a value to a cell otherwise this would trigger the Worksheet_Change over and over again.
Also note that Worksheet_Change is an event. That means it runs automatically whenever a cell value in the worksheet gets changed. You cannot run this procedure manually and you cannot Call it.
I have a code already but I want to know if this code can be altered or if there is a code that can check to see if a cell in the column E is empty and clear contents in a cell in column A if the someone exits the row
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
If Target.Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
End If
End If
End Sub
Edited as per DirkReichel suggestion
Add this formula in A1:
=IF(E1="","",IF(LEN(A1),A1,TODAY()))
Now drag it down in your column "A" as far as you need. It will add today's date in column "A" if there is a value in column "E". Otherwise column "A" will remain empty
You are trying to get information of the "last" selection upon a change.... but there isn't a build-in solution. With a global variable, you still can do like this:
Dim oldTarget As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If oldTarget Is Nothing Then GoTo e
If oldTarget.Rows.Count > 1 Then
Dim x As Range
For Each x In oldTarget.Rows
If x.Cells(1, 5).Value = "" Then x.Cells(1, 1).Value = ""
Next
Else
If oldTarget.Cells(1, 5).Value = "" Then oldTarget.Cells(1, 1).Value = ""
End If
e: Set oldTarget = Target.EntireRow
End Sub
As you see: Dim oldTarget As Range is outside of the sub. This way the set value/object stays until VBA get's stopped (closing the workbook / directly reset vba)
The first bit of your code checks for changes on column E to clear the column A.
So we just need to do the same thing again, but checking if column E is empty when changing column A.
This way, if you change the value on Column A and, at the same row, Column E is empty, it clears what you entered.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
If Target.Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
End If
Elseif Target.Column = 1 Then
If Cells(Target.Row, 5).Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
End If
End If
End Sub
Edit: So, after your comment, here is how you should use your code
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
If Target.Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
Else
'Insert here whatever code you got on the single click event (Except the sub and end sub)
End If
Elseif Target.Column = 1 Then
If Cells(Target.Row, 5).Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
End If
End If
End Sub
In my sheet columns B:C allow dates. I'm trying to create a check to see whether a date entered in C is more recent than B, if so fine, else alert the user and clear contents.
My code returns a run-time error 91 in the application.intersect line:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dates As Range
Set Dates = Range("C4:C12")
If Target.Cells.Count > 1 Or IsEmpty(Target) Then
Exit Sub
End If
If Not Application.Intersect(Dates, Range(Target.Address)).Value > ActiveCell.Offset(0, -1).Value Then
GoTo DatesMissMatch
Else
Exit Sub
End If
DatesMissMatch:
Target.ClearContents
ActiveCell.Value = "A2"
MsgBox "Please re-check dates"
End Sub
I changed your method, but this seems to be working.
I also noticed that you were writing A2 to ActiveCell instead of Target. Did you want the cell in column C to update if invalid data is entered or did you intend for it to be whichever cell you move to that gets changed?
At any rate, here's a way I came up with it
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Or IsEmpty(Target) Then
Exit Sub
End If
If Target.Column = 3 Then 'Check to see if column C was modified
If Target.Value < Target.Offset(0, -1).Value Then
Target.ClearContents
Target.Value = "A2"
MsgBox "Please re-check dates"
End If
End If
End Sub
If you want to stick with the way you are currently doing it, then I think you need to check that the Intersection is not empty as another answer concludes.
I believe you just have to check the intersect than do the compare.
Sub Worksheet_Change(ByVal Target As Range)
Dim Dates As Range
Set Dates = Range("C4:C12")
If Target.Cells.Count > 1 Or IsEmpty(Target) Then
Exit Sub
End If
If Not Application.Intersect(Dates, Range(Target.Address)) Is Nothing Then
If Target.Value < Target.Offset(0, -1).Value Then
GoTo DatesMissMatch
Else
Exit Sub
End If
End If
DatesMissMatch:
Target.ClearContents
ActiveCell.Value = "A2"
MsgBox "Please re-check dates"
End Sub
You can just loop the rows and compare the dates.
Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet
Dim lRow As Long
lRow = 4
Do While lRow <= ws.UsedRange.Rows.count
If ws.Range("C" & lRow).Value > ws.Range("B" & lRow).Value then
GoTo DatesMissMatch
End if
lRow = lRow + 1
Loop
I would like my Excel spreadsheet Column B to be stamped with a date time only when Column A first changes. I have seen a lot of VBA code but it captures the last change, not the first change.
I tried to use this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Offset(0, 1).Value = "" Then
Target.Offset(0, 1) = Format(Now(), "HH:MM:SS")
End If
End Sub
It worked except when I copy and paste into say 3 rows, the date time stamp only shows up for the first of 3 records.
Below code works for me
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
If Target.Column = 1 And Target.Offset(0, 1).Value = "" Then
Target.Offset(0, 1) = Format(Now(), "HH:MM:SS")
End If
Application.EnableEvents = True
End Sub
I receive an error message when attempting to paste into several cells of column A, from this line:
Target.Offset(0, 1).Value = ""
This is because the Offset is a Range of more than one cell, and we can't compare the Value of this Range to an individual value.
You can check Target.Rows.Count. If this is greater than 1 then you can loop through the Target Range, each time checking if the adjacent cell is empty before entering a value into Offset(0, 1).
The following loops through the Target cells, and works even if the Target is a single cell:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Column = 1 Then
Application.EnableEvents = False
For Each rng In Target
If rng.Offset(0, 1).Value = "" Then
rng.Offset(0, 1) = Format(Now(), "HH:MM:SS")
End If
Next rng
Application.EnableEvents = True
End If
End Sub
You should also check if Target extends beyond a single column. If it does, then presumably you only want to enter the stamp into column B (for a change in column A).