Solved: Incremental counter that resets every year

[jcfields]

Hey all,

This post is sort of a continuation of another thread that you guys were helping me with (http://www.vbaexpress.com/forum/showthread.php?t=43540). Unfortunately, I'm just not having any luck going that route and getting this to work, so I'm thinking I'd like to try a different (and probably simpler) approach.

I'm thinking that a macro that simply outputs an integer that is incremented by +1 every time that it is executed would do the trick. It would be executed by selecting "Active" from a drop-down list in the active row in column A. The most tricky part, I think though, is that I'd need the incrementing variable to reset back to 1 the first time that the spreadsheet is opened after 00:00:00 on Jan 1st every year.

Does anyone feel like helpin' a guy out one more time? I appreciate it.

Thanks,
Jeremy

[Teeroy]

Hi Jeremy,

You don't need a macro for that; it's exactly what I suggested last time in a hidden column.
If you don't mind a hidden column you could use a conditional incrementer to generate the suffix.

Pseudo : =IF(year this row = year previous row, previous row value + 1, 001)
If your dates are in A and the hidden column is D the formula in D10(say) would be:
=IF(year(A10)=year(A9),+D9+1,1)
You could concatenate this to the rest of your identifier. If you need it to be a specific number of digits you could use VBA to do the concatenate eg.
Sub test()
[c12] = [c12] & pad([d12], 5)
End Sub

Function pad(i As Integer, length As Integer)
pad = String(length - Len(Trim(Str(i))), "0") & Trim(Str(i))
End Function

[snb]

You can have a counter every time the workbook is being opened in a customdocumentproperty.
When opening the workbook a check will be performed whter a new year has begun since the last time the workbook had been saved; if positive the counter will be reset to 1.


Private Sub Workbook_Open()
On Error Resume Next
With ThisWorkbook
.CustomDocumentProperties.Add "jcfields", False, msoPropertyTypeNumber, 1
With .CustomDocumentProperties("jcfields")
.Value = .Value + 1
If Year(ThisWorkbook.BuiltinDocumentProperties(11)) < Year(Date) Then .Value = 1
End With
End With
End Sub


If the workbook already contains the customdocument property you can reduce the code to:

Private Sub Workbook_Open()
ThisWorkbook.CustomDocumentProperties("jcfields")=ThisWorkbook.CustomDocumentProperties("jcfields")+1
If Year(ThisWorkbook.BuiltinDocumentProperties(11)) < Year(Date) Then ThisWorkbook.CustomDocumentProperties("jcfields").Value = 1
End Sub

[jcfields]

Hi Jeremy,

You don't need a macro for that; it's exactly what I suggested last time in a hidden column.
If your dates are in A and the hidden column is D the formula in D10(say) would be:
=IF(year(A10)=year(A9),+D9+1,1)
You could concatenate this to the rest of your identifier. If you need it to be a specific number of digits you could use VBA to do the concatenate eg.
Sub test()
[c12] = [c12] & pad([d12], 5)
End Sub

Function pad(i As Integer, length As Integer)
pad = String(length - Len(Trim(Str(i))), "0") & Trim(Str(i))
End Function

Teeroy,

Thanks for the help. The only snag with this approach, as with the solution xld came up with for me, is that if the data is sorted on, say, the date from newest to oldest, the ID numbers change with the sort. I wish something that didn't require a macro would work, because VBA makes my head spin. I keep dwelling on the possibility of using a hidden worksheet that wouldn't change with a user's sort operation on the active worksheet, but so far, my mind is drawing a blank.

Thanks,
Jeremy

[jcfields]

You can have a counter every time the workbook is being opened in a customdocumentproperty.
When opening the workbook a check will be performed whter a new year has begun since the last time the workbook had been saved; if positive the counter will be reset to 1.


Private Sub Workbook_Open()
On Error Resume Next
With ThisWorkbook
.CustomDocumentProperties.Add "jcfields", False, msoPropertyTypeNumber, 1
With .CustomDocumentProperties("jcfields")
.Value = .Value + 1
If Year(ThisWorkbook.BuiltinDocumentProperties(11)) < Year(Date) Then .Value = 1
End With
End With
End Sub


If the workbook already contains the customdocument property you can reduce the code to:

Private Sub Workbook_Open()
ThisWorkbook.CustomDocumentProperties("jcfields")=ThisWorkbook.CustomDocumentProperties("jcfields")+1
If Year(ThisWorkbook.BuiltinDocumentProperties(11)) < Year(Date) Then ThisWorkbook.CustomDocumentProperties("jcfields").Value = 1
End Sub


snb,

This is close to what I'm looking for. However, would there be a way to make the counter increment only when it is called from the workbook instead of when the workbook is opened? It would still need to do the date check and reset if the year had changed, but otherwise, if that could be done, this would work perfect.

Thanks,
Jeremy

[snb]

Well put he code somewhere else and link it to a button, if that is what you want.

[Teeroy]

Jeremy,

I missed your earlier comment about sorting. You can place a formula's outcome in the cell via VBA with EVALUATE or code the IF statement in VBA as per below. Important to remember though that both these methods require the data to be sorted by date to give a stable incrementer.

Sub test1()
[D10].Value = Evaluate("=IF(YEAR(A10)=YEAR(A9),+D9+1,1)")
End Sub

Sub test2()
If Year([A10]) = Year([A9]) Then
[D10] = [D9] + 1
Else
[D10] = 0
End If
End Sub

[jcfields]

All,

Thanks once again for the help. Rather than continue to pester everyone here with "what about this?" and "what about that?", I spent the last couple of days trying to learn some VBA (via online tutorials and whatnot) enough that I could figure this thing out for myself. Ultimately, here's what I came up with. It's not perfect, there are ways to "trick" it into producing a bad result, and it could probably be coded more efficiently; but it's a work in progress. It "lives" in the worksheet, instead of in a standard code module, and each worksheet (which all have similar data in them) will have a slightly modified copy of this macro. The macro does several things to several cells, but the portion that addresses the problem this thread was originally opened for is highlighted in bold. (Note that I didn't end up using the incremental counter idea; I just did a simple loop and pasted the result into the spreadsheet.)

Anyway, I just wanted to post an update so no one thinks I just abandoned my thread. Thanks again for all the help; and any constructive criticism is absolutely welcome and appreciated.


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("A")) Is Nothing Then GoTo NextCond1

Select Case Intersect(Target, Columns("A"))

Case Is = "Active"

Target.Offset(0, 1).Select
If Selection.Value = "" Then Selection.Value = Date

Range("D2").Select
Selection.Copy
Target.Offset(0, 3).Select
Selection.PasteSpecial _
Paste:=xlPasteFormulas, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Target.Offset(0, 2).Select
Selection.Value = " "
Selection.Value = ""

Target.Offset(0, 4).Select

Case Is = "Restored"

Target.Offset(0, 2).Select
Selection.Value = Date

Case Is = "Permanent"

Target.Offset(0, 2).Select
Selection.Value = Date

End Select

NextCond1:

If Intersect(Target, Columns("E")) Is Nothing Then GoTo NextCond2

Dim TAPName As String
Dim NewTAPName As String
Dim ExistingTAPName
Dim TAPDate As Range
Dim TAPCounter As Integer

Select Case Intersect(Target, Columns("E"))

Case Is = "1"

TAPCounter = 0

Range("B2", Target.Offset(0, -3)).Select

For Each TAPDate In Selection
If Year(TAPDate) = Year(Target.Offset(0, -3)) Then
If TAPDate.Offset(0, 3).Value = 1 Then
TAPCounter = TAPCounter + 1
End If
End If
Next TAPDate

Case Is = "2"

TAPCounter = 0

Range("B2", Target.Offset(0, -3)).Select

For Each TAPDate In Selection
If Year(TAPDate) = Year(Target.Offset(0, -3)) Then
If TAPDate.Offset(0, 3).Value = 2 Then
TAPCounter = TAPCounter + 1
End If
End If
Next TAPDate

Case Is = "A"

TAPCounter = 0

Range("B2", Target.Offset(0, -3)).Select

For Each TAPDate In Selection
If Year(TAPDate) = Year(Target.Offset(0, -3)) Then
If TAPDate.Offset(0, 3).Value = "A" Then
TAPCounter = TAPCounter + 1
End If
End If
Next TAPDate

Case Is = "G"

TAPCounter = 0

Range("B2", Target.Offset(0, -3)).Select

For Each TAPDate In Selection
If Year(TAPDate) = Year(Target.Offset(0, -3)) Then
If TAPDate.Offset(0, 3).Value = "G" Then
TAPCounter = TAPCounter + 1
End If
End If
Next TAPDate

End Select

Do Until NewTAPName = TAPName

TAPName = "BB" & Target.Value & "-" & Format(Target.Offset(0, -3).Value, "yy") _
& Format(TAPCounter, "-000")
NewTAPName = TAPName

Range("F2", Target.Offset(0, 1)).Select

For Each ExistingTAPName In Selection
If ExistingTAPName = NewTAPName Then
TAPCounter = TAPCounter + 1
NewTAPName = "BB" & Target.Value & "-" & Format(Target.Offset(0, -3).Value, "yy") _
& Format(TAPCounter, "-000")
End If
Next ExistingTAPName

Loop

TAPName = "BB" & Target.Value & "-" & Format(Target.Offset(0, -3).Value, "yy") _
& Format(TAPCounter, "-000")

Target.Offset(0, 1).Select
Selection.Value = TAPName

NextCond2:

End Sub