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
Related
I would like to apply vba formula to designated cells. The vba I am working on would be: If I type something on C2, a date stamp will be automatically put in D2.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 3 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
With Target.Offset(0, 1)
.Value = Now
.NumberFormat = "MM/DD/YYYY"
End With
End Sub
However, if I typed something on C1, a date stamp will appear as well. How can I limit the range of the vba? For example, I just want the date stamp from D2 to D5.
Thanks!!
You can apply Intersect function to check if target falls into the desired range, like this
Dim dr As Range
Set dr = Range("C2:C5")
If Not Intersect(target, dr) Is Nothing Then
... it is OK, go ahead
EndIf
The first answer is right, however here is the full version of it
Paste this in the Project of the table, not as a VBA module
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("C2:C5"), 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
rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy"
Else
rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
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
The code below will add contents of A to B and then clear A across the entire column. How do I duplicate this function to have multiple columns with their own targets inside the same sub? Do I have to write a private sub for each?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, r As Range
Set T = Intersect(Target, Range("A:A"))
If T Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In T
With r
.Offset(0, 1).Value = .Offset(0, 1).Value + .Value
.ClearContents
End With
Next r
Application.EnableEvents = True
End Sub
Thank you!
Single column:
Try using Select Case with Target.Column to determine what to do based on column that had event. Adding a GetLastRow function, following helpful comment from #AJD, to ensure only looping populated column range.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Columns.Count <> 1 Then Exit Sub
Select Case Target.Column
Case 1
'col A do something
ClearRange Target
Case 2
'col B do something
ClearRange Target
'Etc
End Select
Application.EnableEvents = True
End Sub
Public Sub ClearRange(ByVal T As Range) '<== This works on the basis Target is a single column
Dim r As Range, loopRange As Range, ws As Worksheet
Set ws = ThisWorkbook.Worksheets(T.Parent.Name)
Set loopRange = ws.Range(ws.Cells(1, T.Column), ws.Cells(GetLastRow(ws, T.Column), T.Column))
If loopRange Is Nothing Then Exit Sub
'Debug.Print loopRange.Address
For Each r In loopRange
With r
.Offset(0, 1).Value = .Offset(0, 1).Value + .Value
.ClearContents
End With
Next r
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
End With
End Function
tl;dr;
Multi-column:
You can re-write yours as follows. Though I am not sure what happens with multiple columns. Say, columns A:B, simplest case, were Target, does A get looped transfer and added to B, A gets cleared, B gets looped, added to C and B gets cleared? I wasn't really clear so haven't written anything for the inner part. I simply addressed the title of how to add more targets. Happy to update upon clarification.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A:A")) Is Nothing Then
End If
If Not Intersect(Target, Range("B:B")) Is Nothing Then
End If
Application.EnableEvents = True
End Sub
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 a code where the date is updated in the cell in column D if any change was made in the cell in the same row in column F:
Private Sub Worksheet_Change(ByVal Target As Range)
' Code to put the date of the latest update following a change in the corresponding cell in column F
Dim WorkRng As Range
Dim rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("F:F"), Target)
xOffsetColumn = -2 'The date is put 2 columns to the left of column F
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
rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy"
Else
rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
Now I need to adapt this code so that the date is updated in the cell in column D if any change was made in the cells in the same row in columns F to K.
I have very little VBA knowledge and would be grateful for any help in adapting the code.
This appears to work:
Private Sub Worksheet_Change(ByVal Target As Range)
' Code to put the date of the latest update following a change in the corresponding cell in column F
Dim WorkRng As Range, roww As Long
Dim rng As Range
Set WorkRng = Intersect(Range("F:K"), Target)
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
roww = rng.Row
If Not rng.Value = "" Then
Cells(roww, "D").Value = Now
Cells(roww, "D").NumberFormat = "dd/mm/yyyy"
Else
Cells(roww, "D").ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
We just do not use OFFSET()