Incremental numbers with a special format

[Aussiebear]

I am trying to develop a job numbering index with a format based on Year/Month/Incrementing number. The year and month component can be derived from the system date information and the last numbers are simply incrementing by 1 from the previous task. Note that upon a completion of a year the incrementing number restarts a 001. How can this be done?



Date
Result


April 2014
2014-4-001


June 2014
2014-6-002


December 2014
2014-12-003


December 2014
2014-12-004


January 2015
2015-1-001


March 2015
2015-2-002


March 2015
2015-3-003


April 2015
2015-4-004

[Paul_Hossler]

If I'm understanding, I'd do a function and store previous status in the registry




Option Explicit
Sub drvGetNextIncrement()

MsgBox GetNextIncrement()
MsgBox GetNextIncrement()
MsgBox GetNextIncrement()

MsgBox GetNextIncrement(#5/7/2016#)
MsgBox GetNextIncrement(#6/7/2016#)
MsgBox GetNextIncrement(#7/7/2016#)
MsgBox GetNextIncrement(#8/7/2016#)

End Sub

'[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Increment]
'[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Increment\Previous]
' "Year"="2016"
' "Month"="8"
' "Number"="0004"

Function GetNextIncrement(Optional IncrementDate As Date) As String
Dim iYear As Long, iMonth As Long
Dim sLastYear As String, sLastMonth As String, sLastNumber As String

If IncrementDate = 0 Then
iYear = Year(Now)
iMonth = Month(Now)
Else
iYear = Year(IncrementDate)
iMonth = Month(IncrementDate)
End If

'get values from registry
sLastYear = GetSetting("Increment", "Previous", "Year", vbNullString)
sLastMonth = GetSetting("Increment", "Previous", "Month", vbNullString)
sLastNumber = GetSetting("Increment", "Previous", "Number", vbNullString)

'first time init
If Len(sLastYear) = 0 Then sLastYear = Format(iYear, "0000")
If Len(sLastMonth) = 0 Then sLastMonth = Format(iMonth, "#0")
If Len(sLastNumber) = 0 Then sLastNumber = "0000"

'not same year
If sLastYear <> Format(iYear, "0000") Then
sLastYear = Format(iYear, "0000")
sLastMonth = Format(iMonth, "#0")
sLastNumber = "0001"

'same year
Else
sLastMonth = Format(iMonth, "#0")
sLastNumber = Format(CLng(sLastNumber) + 1, "0000")
End If

Call SaveSetting("Increment", "Previous", "Year", sLastYear)
Call SaveSetting("Increment", "Previous", "Month", sLastMonth)
Call SaveSetting("Increment", "Previous", "Number", sLastNumber)


GetNextIncrement = sLastYear & "-" & sLastMonth & "-" & sLastNumber
End Function

[Aussiebear]

Thanks Paul, will test this once I work out the start number correctly.

Currently I am using =Year(Today())&"-"&Month(Today())&"-"&001 but this defaults to 2015-4-1 whereas I was chasing 2015-4-001. will go back and try=Year(Today())&"-"&Month(Today())&"-"&"001"

[Aussiebear]

Errors out with invalid procedure or call but does not highlight a line.

[Paul_Hossler]

1. Did you restart your computer recently?

2. The only thing I can think of is reading / writing to the registry, but HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ should be write-able to you the user

3. The function is pretty basic and runs OK for me


13252

[Paul_Hossler]

Try my file and see if it works

[Aussiebear]

Thank you for your assistance here Paul, but I think I might just stay with setting the initial format using =YEAR(TODAY())&"-"&MONTH(TODAY())&"-"&"001" and then copy down. Just need to change the month and year accordingly.

[Paul_Hossler]

NP - simpler is always better


You could also have

Col A = Year
Col B = Month
Col C = sequence number
Col D = Job Number = Col A + b + c

to make it easier to filter if you wanted to filter just the 2015 February listings

Q: Are you planning to Copy/Paste Values after you fill down into a new row? Otherwise the =YEAR(TODAY())&"-"&MONTH(TODAY())&... will recompute and you'll always have THIS month and THIS year on previous enteries

[Aussiebear]

I don't think I will be. Its more or less a diary type entry listing any job that becomes available on the next available row

[snb]

If column A contains dates:

In B2:

=TEXT(A2;"yyyy-mm")&TEXT(SUMPRODUCT(N(YEAR(A$2:A2)=YEAR(A2)));"-000")

and filldown.

[Aussiebear]

Sorry snb but I've been away on yet another new project (have recently purchased a Volvo ew160b excavator). The dates will always be in column A

[mperrah]

How about this Aussiebear:
In C1 I put "Now Serving:"
in D1 I put "001"
format cell as "000" (this is what ever your most current job number is)
it will increment from this number till encounters a year change, then starts at 001 and updates the "Now Serving" cell

I use Ctrl+: in column A to enter today's date


Sub jobDiarySerial()
Dim cJob
Dim lr, ly, i

lr = Cells(Rows.Count, 1).End(xlUp).Row

cJob = Format(Cells(1, 4), "000")

For i = 2 To lr
If Cells(i, 1).Value <> "" And _
Cells(i, 2).Value = "" Then
ly = Format(Cells(i - 1, 1), "YYYY")
If ly < Format(Cells(i, 1), "YYYY") Then
cJob = "001"
Cells(i, 2).Value = Format(Cells(i, 1), "YYYY") & "-" & Format(Cells(i, 1), "M") & "-" & Format(cJob, "000")
Cells(1, 4).Value = cJob

ElseIf ly = Format(Cells(i, 1), "YYYY") Then
cJob = cJob + 1
Cells(i, 2).Value = Format(Cells(i, 1), "YYYY") & "-" & Format(Cells(i, 1), "M") & "-" & Format(cJob, "000")
Cells(1, 4).Value = cJob
End If
End If
Next i

End Sub

We can trigger the script with a Worksheet_Change event


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Checkmark As Range

Set Checkmark = Range("A:A")

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Checkmark) Is Nothing Then
Call jobDiarySerial
End If
End Sub
hope this makes up for calling you mister :)

[SamT]

Option Explicit


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("A:A")) Is Nothing Then
'this IF allows for more functions in re DoubleVlick Event
NewJobNumber Target
Cancel = True
Exit Sub
End If

End Sub


Sub NewJobNumber(Cel As Range)
Dim LastJobNumber As String
Dim LastValue As Long
Dim NextValue As String

'Prevent adding Job Numbers between jobs
If Not Cel.End(xlDown).Row = Rows.Count Then Exit Sub

'Allow for multirow job descriptions
If Cel.Offset(-1) <> "" Then
LastJobNumber = Cel.Offset(-1).Text
Else
LastJobNumber = Cel.End(xlUp).Text
End If

LastValue = CLng(Right(LastJobNumber, 3))
NextValue = Format(LastValue + 1, "000")

Cel = Year(Now()) & "-" & Month(Now()) & "-" & NextValue


End Sub