michaeltsmith93
Board Regular
- Joined
- Sep 29, 2016
- Messages
- 83
Hi,
I have the following, but it does not work as intended. The idea is that it looks at each row above the row potentially to be populated by the Date, UserName and Index-Match result and checks to see if there is an entry by the same reviewer on that same date. I only want it to create a one entry for a given individual on a given day. The code works fine if I get rid of the For and embedded If statement, but these cause it not to work. I don't get an error--it's just that nothing happens. Is there a way to do this with Find instead of For? I feel like that would be better than looping through, but I'm not sure how to make that work with the And.
I have the following, but it does not work as intended. The idea is that it looks at each row above the row potentially to be populated by the Date, UserName and Index-Match result and checks to see if there is an entry by the same reviewer on that same date. I only want it to create a one entry for a given individual on a given day. The code works fine if I get rid of the For and embedded If statement, but these cause it not to work. I don't get an error--it's just that nothing happens. Is there a way to do this with Find instead of For? I feel like that would be better than looping through, but I'm not sure how to make that work with the And.
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim h2 As Worksheet
Dim u2 As Long
Dim i As Integer
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("L:M")) Is Nothing Then
Cells(Target.Row, "M").Value = Date
Cells(Target.Row, "L").Value = Application.UserName
Set h2 = Sheets("Review_Tracker")
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To u2
If h2.Cells(i, 1).Value = Date And h2.Cells(i, 2).Value = Application.UserName Then
Exit Sub
h2.Cells(u2, "A").Value = Date
h2.Cells(u2, "B").Value = Application.UserName
h2.Cells(u2, "C").Value = WorksheetFunction.Index(Sheets("Reviewer_Roles").Range("A2:B1000"), _
WorksheetFunction.Match(Application.UserName, Sheets("Reviewer_Roles").Range("A2:A1000"), 0), 2)
End If
Next i
End If
End Sub