Multiple "Date Stamp" Macros

gregtgonzalez

New Member
Joined
Dec 16, 2016
Messages
29
Hello All!
I am working on some macros, one i have is triggered when a capital "X" is entered into any cell in a particular column, it then adds the current date right next to it. I had help writing this code, however, I want to alter the macro so that when something populates column "A:A" that column AD populates the date it was entered.

I.e. Assignment is entered into column A on 1/11/2018 and because the column has value input then it will time stamp to show when it was assigned in column AD. I cant seem to get this to work in conjunction with the code below. When the "X" is entered in U:W:Y it does correctly make the time stamp but i cant seem to get them both to wokr at the same time.

Any help would be appreciated!



Private Sub Worksheet_Change_Seven_offset(ByVal Target As Excel.Range)
Dim rCell As Range
Dim rChange As Range

On Error GoTo ErrHandler
Set rChange = Intersect(Target, Range("U:U, W:W, Y:Y"))
If Not rChange Is Nothing Then
Application.EnableEvents = False
For Each rCell In rChange
If rCell = "X" Then
With rCell.Offset(0, 1)
.Value = Now
.NumberFormat = "MM/DD/YY"
End With
Else
rCell.Offset(0, 1).Clear
End If
Next
End If


ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub


End With
Else
rCell.Offset(0, 1).Clear
End If
Next
End If


ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub


altered code
Private Sub Worksheet_Change_Seven_offset_Assignment(ByVal Target As Excel.Range)
Dim rCell As Range
Dim rChange As Range

On Error GoTo ErrHandler
Set rChange = Intersect(Target, Range("A:A"))
If Not rChange Is Nothing Then
Application.EnableEvents = False
For Each rCell In rChange
If rCell = "<>" Then
With rCell.Offset(0, 29)
.Value = Now
.NumberFormat = "MM/DD/YY"
End With
Else
rCell.Offset(0, 29).Clear
End If
Next
End If


ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub


End With
Else
rCell.Offset(0, 29).Clear
End If
Next
End If


ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
 
Last edited:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Hi,

Before responding to your question: please make sure you use the correct code tags in line with forum rules.

See if this works for you:
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rCell As Range
Dim rChange As Range

On Error GoTo ErrHandler
Set rChange = Intersect(Target, Range("A:A, U:U, W:W, Y:Y"))
If Not rChange Is Nothing Then
    Application.EnableEvents = False
    For Each rCell In rChange
        If rCell = "X" Then
            With rCell.Offset(0, 1)
                .Value = Now
                .NumberFormat = "MM/DD/YY"
            End With
        Else
            rCell.Offset(0, 1).Clear
        End If
        If rCell = "<>" Then
            With rCell.Offset(0, 29)
                .Value = Now
                .NumberFormat = "MM/DD/YY"
            End With
        Else
            rCell.Offset(0, 29).Clear
        End If
    Next
    'End If - don't know to what IF statement this "End If" belongs
    'End With - don't know to which With Statement this "End With" belongs.
Else
'   rCell.Offset(0, 1).Clear
End If
'Next - don't know to which "For" statment this "Next" belongs
'End If - don't know to what IF statement this "End If" belongs


ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub
 
Upvote 0
Thank you so much!

it does not seem like the code is working, the date in V X and Z are all populating, but the date stamp for the AD column did not. I saw your notations in your code so i modified it and updated to what was needed
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rCell As Range
Dim rChange As Range

On Error GoTo ErrHandler
Set rChange = Intersect(Target, Range("A:A,U:U, W:W, Y:Y"))
If Not rChange Is Nothing Then
Application.EnableEvents = False
For Each rCell In rChange
If rCell = "X" Then
With rCell.Offset(0, 1)
.Value = Now
.NumberFormat = "MM/DD/YY"
End With
Else
rCell.Offset(0, 1).Clear
End If
If rCell = "X" Then
With rCell.Offset(0, 29)
.Value = Now
.NumberFormat = "MM/DD/YY"
End With
Next
End If


ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
 
Last edited:
Upvote 0
Hi,

My code was based upon the altered code you've provided in which the date in Column AD was populated on a code of "<>" in column A.
You've changed the code to populate Column AD when typed X in column A but ...the changes you've created also creating a time stamp in Column AX when X entered in U, etc.
If that's ok, fine. In any other case you need to redo the code.
 
Upvote 0
Additional to previous response. The changed code and as a reminder: please use the correct code tags to keep the forum readable!!

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rCell As Range
Dim rChange1, rChange2 As Range

On Error GoTo ErrHandler
Set rChange1 = Intersect(Target, Range("U:U, W:W, Y:Y"))
If Not rChange1 Is Nothing Then
    Application.EnableEvents = False
    For Each rCell In rChange1
        If rCell = "X" Then
            With rCell.Offset(0, 1)
                .Value = Now
                .NumberFormat = "MM/DD/YY"
            End With
        Else
            rCell.Offset(0, 1).Clear
        End If
    Next
End If

Set rChange2 = Intersect(Target, Range("A:A"))
If Not rChange2 Is Nothing Then
    Application.EnableEvents = False
    For Each rCell In rChange2
        If rCell = "X" Then
            With rCell.Offset(0, 29)
                .Value = Now
                .NumberFormat = "MM/DD/YY"
            End With
            Else
                rCell.Offset(0, 29).Clear
            End If
    Next
End If


ExitHandler:
Set rCell = Nothing
Set rChange1 = Nothing
Set rChange2 = Nothing
Application.EnableEvents = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
 
Last edited:
Upvote 0
Sorry yes, as i was messing with the information to try and get it to work, i changed the parameters to be specific to a "X" to see if that would trigger the macro to work. As i understan it "<>" means any value correct? Which is what i wanted, but I think i need to review the code more thoroughly.
I do apolgoize for using the incorrect tags, but I'm not familiar enough to update the tags. I'm not familiar with the tagging guidelines, but I will be sure to review them. I will look up how to change the tags this afternoon.
 
Upvote 0
The code tags are the # icon in the reply window. Either paste your code to the window, select it & then click the # icon.
Alternatively click the # icon & then paste your code between the tags
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top