I have an excel file that is actually a database that I update regularly. Each time that I do an update, I want to filter the data I entered on that particular day.
So I found this macro online that is really great for my application.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range, D As Range, Inte As Range, r As Range
Set C = Range("C:C")
Set Inte = Intersect(C, 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
It gives me the cell D the date of the day when I modified the cell C. The problem is, I only want the date to appear if I really put a text in the cell C. Sometimes I just insert a line, but empty in cell C, and the macro considers it as an event. It then gives me the date in cell D, however I haven't written anything.
I guess this should be a pretty simple line to add somewhere in the macro with a If Not IsEmpty(C.Value) Then but I haven't been able to put it at the correct place, since it doesn't work...
Thank you in advance for any help you may procure. And have a nice weekend all!
try
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range, D As Range, Inte As Range, r As Range
Set C = Range("C:C")
Set Inte = Intersect(C, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
If Not IsEmpty(r.Value) Then ' line added
r.Offset(0, 1).Value = Date
Else
r.Offset(0, 1).Value = ""
End If
Next r
Application.EnableEvents = True
End Sub
Use SpecialCells to act on not empty cells only
And you don’t need to loop
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Inte As Range
Set Inte = Intersect(Range("C:C"), Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
Inte.SpecialCells(xlCellTypeConstants).Offset(0, 1).Value = Date
Application.EnableEvents = True
End Sub
Related
Disclaimer: I'm very new to VBA, so obvious things probably fly over my head.
I'm trying to set up 2 columns that automatically update with that day's date when the column next to it receives new data in that sheet only.
I tried, with my limited knowledge, to create new variables, so that it has 2 'lines' to go with, if that makes sense, but it just stops working altogether.
Is there any way I can 'duplicate' the below code so that column O updates with today's date when column P is updated, and the same for column E when D is changed? If possible, it would be nice if column E didn't update when the text in D is "N/A"
Any help or pointers are appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("P:P"), Target)
xOffsetColumn = 1
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 = Now
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
UpdateNextColumnIfNeeded Application.Intersect(Me.Range("P:P"), Target)
UpdateNextColumnIfNeeded Application.Intersect(Me.Range("D:D"), Target)
Application.EnableEvents = True
End Sub
Private Sub UpdateNextColumnIfNeeded(ByVal WorkRng As Range)
If WorkRng Is Nothing Then Exit Sub
Dim Rng As Range
For Each Rng In WorkRng.Cells
If IsEmpty(Rng.Value) Then
Rng.Offset(0, 1).ClearContents
Else
Rng.Offset(0, 1).Value = Now
End If
Next
End Sub
You will need to put checks in place so that you only have 1 worksheet_change, but allowing separate actions depending on the target range. Try something like:
Select Case Target.Column
Case 15
'that stuffs
Case 16
'that other stuffs
End Select
edtit1 yes, #GSerg, that is true... updated
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'm going to start by saying I'm not very good with coding.
The issue I'm having is when I delete my text in cell "L" the date stays in cell "J". How do I make it automatically delete itself if "L" is blank? Basically if a cell in "L" is blank I want the corresponding cell in "J" to be blank.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim L As Range, Inte As Range, r As Range
Set L = Range("L:L")
Set Inte = Intersect(L, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
ActiveSheet.Range("J" & r.Row).Value = Date
Next r
Application.EnableEvents = True
End Sub
You can work this in to the code:
Range("L1:L10").SpecialCells(xlCellTypeBlanks).Offset(0, -2).ClearContents
Just adjust the range as necessary.
So I'm adding a picture so you can see exactly what I need it to do -Excel sheet picture
So I have this script:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, G, L, N As Range, Inte As Range, r As Range
Set A = Range("F:F,K:K,M:M")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
If r.Offset(0, 1).Value = "" Then
r.Offset(0, 1).Value = Date
End If
Next r
Application.EnableEvents = True
End Sub
We will talk about only what we see in the picture: so now when I write anything in column F it gives the date in column G, I want that it will give the date only if I write "Ja" (Yes in German) or "Yes"
Simple is that. I tried to find any "if" commands for it but none of mine worked.
Hope you can help me with that
Thanks!
Daniel
Here is a better practice to achieve that also you need to set Application.EnableEvents back to True when you are existing the method for the next time the event will be raised, also its not bad to make some "house keeping" and use error catch if something goes wrong:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ende
Application.EnableEvents = False
Set A = Range("F:F,K:K,M:M")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then
Application.EnableEvents = True
Exit Sub
End If
For Each cel In Target
r = cel.Row
c = cel.Column
If Trim(LCase(Cells(r, c))) = "yes" Or Trim(LCase(Cells(r, c))) = "ja" Then
Cells(r, c + 1) = Format(Date, "dd.MM.yyyy")
Else
' do something else
End If
Next
ende:
Application.EnableEvents = True
End Sub
What about this?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim rng As Range
Set rng = Range("F:F,K:K,M:M")
On Error GoTo SkipError
Application.EnableEvents = False
If Not Intersect(Target, rng) Is Nothing Then
For Each cell In Target
If LCase(VBA.Trim(cell.Value)) = "yes" Then
cell.Offset(0, 1) = Date
End If
Next cell
End If
SkipError:
Application.EnableEvents = True
End Sub
i have the following code which would auto-fill the date in column B once i add value's in column A.
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
If r.Offset(0, 1).Value = "" Then
r.Offset(0, 1).Value = Date & " " & Time = "hh:mm:ss AM/PM"
End If
Next r
Application.EnableEvents = True
End Sub
what im looking for is to also add the current time to column C.
ok so i found what im looking for but it requires little modification where the date and time are being set.
below is the code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("D:D")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
If r.Value > 0 Then
r.Offset(0, -3).Value = Date
r.Offset(0, -3).NumberFormat = "dd-mm-yyyy"
r.Offset(0, -2).Value = Time
r.Offset(0, -2).NumberFormat = "hh:mm:ss AM/PM"
Else
r.Offset(0, -3).Value = ""
r.Offset(0, -2).Value = ""
End If
Next r
Application.EnableEvents = True
End Sub
to auto-fill column E with date, instead of column A
and auto-fill column F with time, instead of column B
and if possible im trying to have the same process but another cell on the same sheet.
While you might look at using SpecialCells to do this in one hit rather than a loop, a simple mod to your code would be:
one-shot per range area method
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
On Error Resume Next
For Each r In Inte.Areas
r.Offset(0, 1).Cells.SpecialCells(xlCellTypeBlanks) = Date
r.Offset(0, 2).Cells.SpecialCells(xlCellTypeBlanks) = Time
Next r
Application.EnableEvents = True
End Sub
initial answer
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
If r.Offset(0, 1).Value = vbNullString Then r.Offset(0, 1).Value = Date
If r.Offset(0, 2).Value = vbNullString Then r.Offset(0, 2).Value = Time
Next r
Application.EnableEvents = True
End Sub
if you want to:
put current Date in Target adjacent column blank cells
put current Time in Target adjacent column blank cells adjacent cells
then go like follows:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A:A"), Target).Address <> Target.Address Then Exit Sub '<--| exit if all target cells aren't in column "A"
Application.EnableEvents = False
If WorksheetFunction.CountBlank(Target.Offset(, 1)) = 0 Then Exit Sub '<--| exit if no blank cells in target adjacent column
With Target.Offset(, 1).SpecialCells(xlCellTypeBlanks) '<--| reference blank cells in target adjacent column
.Value = Date '<--| set referenced cells value to the current date
.Offset(, 1).Value = Time '<--| set referenced cells adjacent ones value to the current time
End With
Application.EnableEvents = True
End Sub
While if you want to:
put current Date in Target adjacent column blank cells
put current Time in Target two columns offset blank cells
then go like follows:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A:A"), Target).Address <> Target.Address Then Exit Sub '<--| exit if all target cells aren't in column "A"
Application.EnableEvents = False
On Error Resume Next
Target.Offset(, 1).SpecialCells(xlCellTypeBlanks).Value = Date '<--| set target adjacent column blank cells to the current date
Target.Offset(, 2).SpecialCells(xlCellTypeBlanks).Value = Time '<--| set target two columns offset blank cells to the current time
Application.EnableEvents = True
End Sub
where the On Error Resume Next is there to avoid two distinct If WorksheetFunction.CountBlank(someRange) Then someRange.SpecialCells(xlCellTypeBlanks).Value = someValue statements
Normally you would avoid On Error Resume Next statement and ensure you're handling any possible errors.
But in this case, being it confined to the last two statements of a sub, I think it's a good trade off in favour of code readability without actually loosing its control