Generate Current Year with Unique ID

[mtaylor50]

Greetings,
I'm grateful for finding the Worksheet Change code below on this forum. After a small modification per my needs, it successfully generates a unique ID in column AB whenever a new record is entered in column A. I would like to modify the code so that the current year and a hyphen always precede the unique ID. E.g., the first record in 2018 would be 2018-1; the next would be 2018-2; etc. Then the first record to be entered in 2019 would be 2019-1, and so on. I’ve attempted to modify the code, as well as find the solution on the forum, but to no avail so far. Any suggestions would be greatly appreciated -thank you.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If Target.Rows.Count > 1 Then Exit Sub
    If Cells(Target.Row, 27) > 0 Then Exit Sub
    maxNumber = Application.WorksheetFunction.Max(Range("AB:AB"))
    Target.Offset(0, 27) = maxNumber + 1
    End If
End Sub

 

[RasGhul]

Try changing this line;

Target.Offset(0, 27) = Format(Now(), "yyyy-") & maxNumber + 1

 

[mtaylor50]

Try changing this line;

Target.Offset(0, 27) = Format(Now(), "yyyy-") & maxNumber + 1

Thank you, RasGuhl. I modified the code as you suggested. I then entered 8 new records. The year appeared each time, but the last digit stayed the same; the ID showed as 2018-1 for each of the 8 new records. Any other thoughts?

 

[MickG]

Try this:-

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] maxNumber, Sp [COLOR="Navy"]As[/COLOR] Variant, Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] t
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Application.EnableEvents = False
    [COLOR="Navy"]If[/COLOR] Not Intersect(Target, Range("A:A")) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
     [COLOR="Navy"]If[/COLOR] Target.Rows.Count > 1 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
       [COLOR="Navy"]If[/COLOR] Cells(Target.Row, 27) > 0 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Rng = Range(Range("AB1"), Range("AB" & Rows.Count).End(xlUp))
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                    Sp = Split(Dn.Value, "-")
                    [COLOR="Navy"]If[/COLOR] Sp(0) = CStr(Year(Now)) [COLOR="Navy"]Then[/COLOR] Temp = Sp(1)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Dn
            [COLOR="Navy"]If[/COLOR] Temp = 0 [COLOR="Navy"]Then[/COLOR]
                Target.Offset(0, 27) = Year(Now) & "-1"
            [COLOR="Navy"]Else[/COLOR]
                Target.Offset(0, 27) = Year(Now) & "-" & Temp + 1
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[mtaylor50]

Mick,
This works perfectly - exactly what I needed. I appreciate your time and skill, and the valuable resource this forum provides. Thanks again.
Mark

 

[MickG]

You're welcome

 

[Rick Rothstein]

Try this:-

Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]Dim[/COLOR] maxNumber, Sp [COLOR=Navy]As[/COLOR] Variant, Temp [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] t
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Application.EnableEvents = False
    [COLOR=Navy]If[/COLOR] Not Intersect(Target, Range("A:A")) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
     [COLOR=Navy]If[/COLOR] Target.Rows.Count > 1 [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]
       [COLOR=Navy]If[/COLOR] Cells(Target.Row, 27) > 0 [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]
        [COLOR=Navy]Set[/COLOR] Rng = Range(Range("AB1"), Range("AB" & Rows.Count).End(xlUp))
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
                [COLOR=Navy]If[/COLOR] Not IsEmpty(Dn.Value) [COLOR=Navy]Then[/COLOR]
                    Sp = Split(Dn.Value, "-")
                    [COLOR=Navy]If[/COLOR] Sp(0) = CStr(Year(Now)) [COLOR=Navy]Then[/COLOR] Temp = Sp(1)
                [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]Next[/COLOR] Dn
[COLOR=#ff0000][B]            If Temp = 0 Then
                Target.Offset(0, 27) = Year(Now) & "-1"
            Else
                Target.Offset(0, 27) = Year(Now) & "-" & Temp + 1
            End If
[/B][/COLOR]    [COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

You do not need the If..Then..Else..EndIf structure highlighted in red above as the Else code line will work correctly even when Temp equal 0...

Target.Offset(0, 27) = Year(Now) & "-" & Temp + 1

 

[MickG]

Yes, It obvious in Hindsight !!!!