Log to generate tracking numbers

[ocu2fan]

Thank you in advance for your help with this. I'm not any sort of expert in Excel, but my boss has tasked me with updating a log that we use for tracking boxes pulled for onsite research. We are rolling out a new system beginning July 1, so the workbook is currently formatted for the months of July (Sheet 11) and August (Sheet 12) only.

First off we use Excel 2016. The workbook contains 13 visible sheets (Recap followed by 1 sheet for each month of the year).

There are 8 visible columns, but it's the first two that are important (Tracking Number and Date).

I was able to find a code that would generate a new 'Tracking Number' when the 'Date' is filled in:


Private Sub Worksheet_Change(ByVal Target As Range)

Dim maxNumber

If Not Intersect(Target, Range("B:B")) Is Nothing Then

' don't run when more than one row is changed

If Target.Rows.Count > 1 Then Exit Sub

' if column A in the current row has a value, don't run

If Cells(Target.Row, 1) > 0 Then Exit Sub

' get the highest number in column A, then add 1 and write to the

' current row, column A

maxNumber = Application.WorksheetFunction.Max(Range("A:A"))

Target.Offset(0, -1) = maxNumber + 1

End If

End Sub


This is the easiest part since all I needed was to have the two digit Fiscal Year (19) followed by a sequential number: (Worksheet July A2) 19-1.

This would be fine if we were using just one worksheet, but since the workbook is broken down by month my boss would like the numbering to continue on each subsequent month. So if in the month of July we begin with 19-1 and end with 19-20, August's first tracking number should be 19-21 and so on.

I can't find anything online that would make it possible for the 'Tracking Number' to continue on the next sheet with a 'Tracking Number' that would be the last tracking number in July +1.

Like I said, we are starting this on July 1. Our Fiscal Year ends September 30, so I would need to be able to replicate the code into a new workbook for next Fiscal Year beginning October 1.

I really hope this makes sense. I am not a VBA expert and I would barely call myself a novice. I can't seem to find anything online that is close to what I need.

My apologies in advance, if I didn't provide enough specificity. Thank you again for your assistance.

[Paul_Hossler]

There's Workbook level events that can handle all worksheets

Play with this

I added a double click in the Date column B that enters today's date, and the Change event gets the next number in the current month, or if Row 2, in the previous month




Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim maxNumber As Long
Dim sPrevMonth As String
Dim aryMonths As Variant
Dim iMonth As Long

If UCase(Sh.Range("B1").Value) <> "DATE" Then Exit Sub

If Target.Cells.Count > 1 Then Exit Sub

If Target.Column <> 2 Then Exit Sub

'this is first entry for next month
If Target.Row = 2 Then
aryMonths = Application.GetCustomListContents(4)

iMonth = 0
On Error Resume Next
iMonth = Application.WorksheetFunction.Match(Sh.Name, aryMonths, 0)
On Error GoTo 0

'is this sheet a month?
If iMonth = 0 Then Exit Sub

Select Case iMonth
Case 1
sPrevMonth = aryMonths(iMonth + 11)
Case 2 To 9
sPrevMonth = aryMonths(iMonth - 1)
'if october, so start over
Case 10
maxNumber = 0
Case 11 To 12
sPrevMonth = aryMonths(iMonth - 1)
End Select

' get the highest number in column A of previous month then add 1 and write to the current row, column A
If iMonth <> 10 Then ' set by October Case
maxNumber = Application.WorksheetFunction.Max(Worksheets(sPrevMonth).Range("A:A"))
End If
Application.EnableEvents = False
Target.Offset(0, -1) = maxNumber + 1
Application.EnableEvents = True

'just add one to this sheet's max
Else
' get the highest number in column A, then add 1 and write to the current row, column A
maxNumber = Application.WorksheetFunction.Max(Sh.Range("A:A"))
Application.EnableEvents = False
Target.Offset(0, -1) = maxNumber + 1
Application.EnableEvents = True
End If

End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If UCase(Sh.Range("B1").Value) <> "DATE" Then Exit Sub

If Target.Cells.Count > 1 Then Exit Sub

If Target.Row < 2 Or Target.Column <> 2 Then Exit Sub

If Len(Target.Offset(0, -1).Value) > 0 Then Exit Sub

'leave events enabled so Workbook_SheetChange fires
Target.Value = Date
End Sub

[ocu2fan]

Wow! Thank you so much. This is perfect.

Is there any way to drop this into the existing workbook (WORKING_COPY Pull Log.xls) and have it only generate new numbers for July-Aug-Sept? I tried adding it in, but the numbers that it generates are '19-43642' etc.

I'm sure I'm doing something wrong. Is it better to just start with the new clean workbook that you attached above?

[Paul_Hossler]

OK, here it is

Did you delete old Change events in each worksheet?

I added one line but that we for a special case

I double clicked the green cell in July (B6) and it entered the next, and then B2 in August and it carried over

[ocu2fan]

Paul_Hossler - THANK YOU so much for your help. This is marvelous. I wish I had even a little ability in this area. My knowledge is nothing and I'm super impressed and thankful.

I really appreciate your help with this.

Best ocu2fan