Each row to contain a unique ID (via VBA)

Hi

I am a VBA novice. So apologies in advance if the question is an easy one.

I have some code (see below) which gives me a unique id in column A for each row. The format is yymm-0. Currently the numbering portion does not reset, it just carries on consecutively. I would like it to restart when the month changes.

So for May I would like the numbering to go 0905-1, 0905-2... until June, when it would reset and go as follows 0906-1, 0906-2.

Is anyone able to help?

Sub NewNumber(MySheet As String, myRow As Long, MyColumn As Long)
Dim NewNumber As String

'test for blank, ie no current number
If ActiveSheet.Cells(myRow, MyColumn) = "" Then
      
'check to make sure in Column 1
If MyColumn = 1 Then
         
'check to make sure there is a blank cell in the next column, if blank, then no current record
If ActiveSheet.Cells(myRow, MyColumn + 1) = "" Then
            
'check to make sure that the cell above has something in it
If ActiveSheet.Cells(myRow - 1, MyColumn) > "" Then

             NewNumber = (Format(Now, "yymm")) + "-" + Right(Str(myRow - 1), Len(Str(myRow)) - 1)
               ActiveSheet.Cells(myRow, MyColumn) = NewNumber
               ActiveSheet.Cells(myRow - 1, MyColumn).Copy
               ActiveSheet.Cells(myRow, MyColumn).PasteSpecial Paste:=xlFormats
               Application.CutCopyMode = False
               SetRowDefaults myRow
            End If
         End If
      End If
   End If


End Sub

Hi

Try this

Sub NewNumber(MySheet As String, myRow As Long, MyColumn As Long)
Dim NewNumber As String

'test for blank, ie no current number
If ActiveSheet.Cells(myRow, MyColumn) = "" Then
      
'check to make sure in Column 1
If MyColumn = 1 Then
         
'check to make sure there is a blank cell in the next column, if blank, then no current record
If ActiveSheet.Cells(myRow, MyColumn + 1) = "" Then
            
'check to make sure that the cell above has something in it
If ActiveSheet.Cells(myRow - 1, MyColumn) > "" Then
  If WorksheetFunction.CountIf(Range("A1:A" & myRow - 1), Format(Now, "yymm") & "*") = 0 Then
    NewNumber = Format(Now, "YYMM") & "-1"
  Else
    NewNumber = (Format(Now, "yymm")) + "-" + Right(Str(myRow - 1), Len(Str(myRow)) - 1)
  End If
               ActiveSheet.Cells(myRow, MyColumn) = NewNumber
               ActiveSheet.Cells(myRow - 1, MyColumn).Copy
               ActiveSheet.Cells(myRow, MyColumn).PasteSpecial Paste:=xlFormats
               Application.CutCopyMode = False
               'SetRowDefaults myRow
            End If
         End If
      End If
   End If


End Sub

rylo