Multiple "Date Stamp" Macros

[gregtgonzalez]

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

 

[jorismoerings]

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:

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

 

[gregtgonzalez]

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

 

[jorismoerings]

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.

 

[jorismoerings]

Additional to previous response. The changed code and as a reminder: please use the correct code tags to keep the forum readable!!

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

 

[gregtgonzalez]

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.

 

[Fluff]

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