Hi all
Hope you can help i need to crate a serial number generator that creates a new serial number for every entry , and resets to 01 every day.
So far i have, the sheet auto populating The User ID, the date and it crates a Serial number, but i cant think/find a way to get the Serial number to reset to 01 each day.
Top code Add User ID and the Serial number bottom code adds the date.
sorry cant upload a mini sheet it a works PC and it very restricted
Hope you can help i need to crate a serial number generator that creates a new serial number for every entry , and resets to 01 every day.
So far i have, the sheet auto populating The User ID, the date and it crates a Serial number, but i cant think/find a way to get the Serial number to reset to 01 each day.
Top code Add User ID and the Serial number bottom code adds the date.
VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
i = Application.WorksheetFunction.CountA(Sheet1.Range("d:d"))
If i > 1 Then
Sheet1.Range("b" & i).Value = i - 1
i = Application.WorksheetFunction.CountA(Sheet1.Range("d:d"))
If i > 1 Then
Sheet1.Range("c" & i).Value = Application.UserName
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("c:c"), Target)
xOffsetColumn = -2
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
sorry cant upload a mini sheet it a works PC and it very restricted