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
Related
Private Sub Worksheet_Change(ByVal Target As Range)
StartRow = 21
EndRow = 118
ColNum = 1
For i = StartRow To EndRow
If Cells(i, ColNum).Value = Range("A4").Value Then
Cells(i, ColNum).EntireRow.Hidden = True
Else
Cells(i, ColNum).EntireRow.Hidden = False
End If
Next i
End Sub
The Range I want to dictate when the code is run is D21:D118. It will start out blank and then have data pulled into it
Thank you!
It's quite difficult and error-prone to tell in a Change event handler what the previous cell value was before it was edited. You might consider narrowing the logic so it only runs if a cell in A21:A118 is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range, vA4
'Does Target intersect with our range of interest?
Set rng = Application.Intersect(Target, Me.Range("A21:A118"))
If rng Is Nothing Then Exit Sub 'no change in monitored range
vA4 = Me.Range("A4").Value
For Each c In rng.Cells 'loop over updated cells
c.EntireRow.Hidden = (c.Value = vA4) 'check each updated cell value
Next c
End Sub
I have Sheet1 looking like this
running this code:
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("B2:K10"), Target)
xOffsetColumn = 11
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, hh:mm:ss"
Else
rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
What it does so far:
when I edit anything in range B2:K10 it adds the date & time on the right side of the table
What I need:
when I edit anything in the range specified above, log the date & time plus the corresponding step & item, all into Sheet2 starting from A2
Expected result:
And keep adding below last row over and over, never erase a record if a value is deleted from a cell in Sheet1. Will delete records manually if needed.
try this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim rng As Range
Dim nextRow As Long
Set WorkRng = Intersect(Application.ActiveSheet.Range("B2:K10"), Target)
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
If Not VBA.IsEmpty(rng.Value) Then
nextRow = Log.Cells(Rows.Count, 1).End(xlUp).Row + 1
Log.Cells(nextRow, 1) = Me.Cells(rng.Row, 1)
Log.Cells(nextRow, 2) = Me.Cells(1, rng.Column)
Log.Cells(nextRow, 3) = Now
Log.Cells(nextRow, 3).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
End If
Next
Application.EnableEvents = True
End If
End Sub
The code identifies the row number of the next empty row in Sheet 2, then writes the values into the first three cells of that row.
Edit: After seeing your edits to the code: You don't need to go through the hassle of declaring a worksheet variable and then setting it to the sheet. Instead, use the (Name) property to give the sheet a name, then you can access it from anywhere in the code via this name. I adjusted the code to reflect this.
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 have problem in my code, i need to change in another column - row
I tried to built macro but it's dosn't work with that.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Target, Range("A6:U1000"))
If xRg Is "YES" Then Exit Sub
Range("G" & Target.Row).Value = "CHECK"
End Sub
When in column N6:N1000 is "YES" in Column G change value to "Check" and all row A6 for example to U1000 is in color red
I can't quite understand what you're trying to achieve here, but hopefully the below will be doing roughly what you need. Try it and let me know if it doesn't behave the way you hope.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim xRg As Range, cl as Range
Set xRg = Intersect(Target, Range("A6:U1000"))
If Not xRg Is Nothing Then
For Each cl In xRg.Cells
If cl.Value = "YES" Then Range("G" & cl.Row).Value = "CHECK"
Next
End If
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()