Macro for automatic request registration.

Question

Hi there,

I have a sequence of serial numbers on a database (A001, A002, etc). Whenever we register a new request, it must have the next number on the sequence. I aim to create a macro that finds the last serial number on the registration row and inputs the next one below it.

I'm trying to use autofill, with the range being the current base, and the destination being the next cell, just below the current ones, but haven't been able to.

Would appreciate any suggestions. Cheers!

Answer 1

Re: "Would appreciate any suggestions."

' A little different approach...
' Place the code in a standard module - at the top.

' The code uses "Sheet1" - <<< ADJUST

' It also uses the text/number format you provided ("A001").

' If that format is changed the code must be revised.

' Pressing the Shift key and clicking the button displays an Input box to the user.
' If you don't press the Shift key then nothing happens.

' (the guy in the next cube may be a practical joker)
' The Inputbox displays the new invoice number.

' Row 2 and Column C are up to you.

' You don't need a database of numbers.

' What ever you enter in Cell A3 is the starting number > (A000) +1.

'---

'---

#If VBA7 Then
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#Else
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#End If

Sub AssignInvoiceNumbers() '©
'Nothing Left to Lose - code updated June 2022
On Error GoTo Err_Handler
Dim lngNum As Long
Dim lngLast As Long
Dim strValueOne As String
Dim strValueTwo As String

If GetKeyState(vbKeyShift) < 0 Then
TryAgain:
With ThisWorkbook.Worksheets("Sheet1").Range("A3")
'strValueOne = VBA.Left(.Value, 3) & Custom_Functions.NumsRight(.Value) + 1
strValueOne = VBA.Left(.Value, 3) & VBA.Right(.Value, VBA.Len(.Value) - 3) + 1
Application.Cursor = xlDefault
strValueTwo = VBA.InputBox("The next record number is: " & strValueOne & _
vbCr & "Enter the new number in the box below." & vbCr & _
"To make no change leave the box blank or press Cancel.", _
"New Registration Number")
End With
If VBA.Len(strValueTwo) = 0 Then
Exit Sub
ElseIf VBA.StrComp(strValueOne, strValueTwo, vbTextCompare) = 0 Then
With ThisWorkbook.Worksheets("Sheet1")
.Range("A3").Value = VBA.UCase$(strValueTwo)
lngLast = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
.Cells(lngLast, 2).Value = Date & " - " & VBA.UCase$(strValueTwo)
End With
Exit Sub
Else
GoTo TryAgain
End If
End If
Exit Sub
Err_Handler:
Beep
Beep
End Sub

'---

Nothing Left to Lose https://1drv.ms/u/s!Au8Lyt79SOuhZw2MCH7_7MuLj04?e=sAwbHU (free excel programs)