Yes for sure, below is my code

<Code>
Str = tRangeShort + Right(Year(dtDate.Value), 2) + Month(dtDate.Value)
txtDocNo.Text = GetIncrementalSerialNumber(NewRange, Str)

Private Function GetIncrementalSerialNumber(inRange As Range, sStr As String) As String
Dim StrSrch As String, tSerial As String, tNo As String
Dim tDigit As Integer, i As Integer
Dim tpRange As Range

StrSrch = sStr & "*" 'Concatenate an (*) at the end of the string
tSerial = ""
tNo = 0

For Each tpRange In inRange
If tpRange.Value Like StrSrch Then
tNo = tNo + 1 'Counter to find the number of exact matches
End If
Next tpRange
tNo = tNo + 1 'Adding 1 to total number of exact matches available

tDigit = 3 - Len(tNo) 'Find the length of the counter to prefix 0s
For i = 1 To tDigit
tSerial = "0" & tSerial 'Prefix 0s as required
Next i

GetIncrementalSerialNumber = sStr & tSerial & tNo 'Concatenate all
End Sub
<\Code>