View Full Version : Solved: Incremental counter that resets every year
jcfields
09-07-2012, 11:46 AM
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
09-07-2012, 10:06 PM
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
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
09-10-2012, 06:16 AM
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
09-10-2012, 06:37 AM
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
Well put he code somewhere else and link it to a button, if that is what you want.
Teeroy
09-10-2012, 03:35 PM
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
09-13-2012, 12:51 PM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.