Home > Software design >  VBA - Finding the Next row and Auto-incrementing the Log ID
VBA - Finding the Next row and Auto-incrementing the Log ID

Time:12-19

Assistance required on this one, its probably something easy but im still developing when it comes to VBA.

I have a userform that is used to update a log of requests, i want it to operate so that it looks down column A to establish the Last row and the Last used reference number. Once the new submission is entered i want it to populate to the next blank row whilst auto incrementing the reference number. The reference Numbers are formatted as below.

Column A (RefNo) Column B LA
LSI-1 Data
LSI-2 Data
LSI-3 Data
LSI-4 Data
etc.. Data

just for reference, due to the logs headers etc, LSI-1 starts on row 6.

Private Sub UserForm_Initialize()

Me.Height = 424
Me.Width = 438
Me.Zoom = 100

Txt_DateLogged.Value = Format(Date, "dd/mm/yyyy")
Txt_Month.Value = Format(Date, "MMM-YY")

Call CBO_Supplier_Items
Call CBO_SRM_Items
Call CBO_Cause_Items

Dim ws As Worksheet
Dim i As Long


Set ws = ThisWorkbook.Sheets("LSI Log")


With ws
    i = .Rows.Count
    lstdt = .Range("A" & i).End(xlUp).Value
    Me.Txt_IssueNum.Value = "LSI-" & lstdt   1
    
    End With
        

End Sub

On the userform there is a textbox Txt_IssueNum which is not enabled but i want it to be populated with the new reference number during the userform Initialising.

When i run my code above i get the Error Type Mismatch error message.

Any thoughts where im going wrong with it?

Thanks in advance.

CodePudding user response:

Threw this together so might not be the best code for finding the max (end of the day).....

With your data as below (not sorted, different text in there)

enter image description here

Option Explicit

Public Sub Test()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    'Set reference to your data range.
    Dim TheData As Range
    With ws
        Set TheData = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    
    'Ask for the next ID relevant to LSI- type.
    MsgBox GetNextID(TheData, "LSI-")

End Sub

Public Function GetNextID(MyDataRange As Range, StartText As String) As String
    
    Dim IDCollection As Collection
    Set IDCollection = New Collection
    
    'Put all numbers relevant to the correct type into a collection.
    Dim itm As Variant
    For Each itm In MyDataRange
        If Left(itm, Len(StartText)) = StartText Then
            'Remove the StartText, turn the number into a value.
            IDCollection.Add Val(Replace(itm, StartText, ""))
        End If
    Next itm
    
    'Find the maximum number.
    Dim MaxNum As Long
    For Each itm In IDCollection
        If itm > MaxNum Then MaxNum = itm
    Next itm
    
    'Add the StartText back and return the result.
    GetNextID = StartText & MaxNum   1
    
End Function  

Results when looking for "LSI-" and then "AB-":
enter image description here

CodePudding user response:

Extract Trailing Integers

A Test

  • Use this test sub before using the function in your sub.
Sub Test()
    Debug.Print GetNewId
End Sub

The Function

  • Adjust the first cell "A2".
Function GetNewId() As String
    
    Const ID_PREFIX As String = "LSI-"
    
    Dim IdNumbers()
    
    With ThisWorkbook.Sheets("LSI Log")
        Dim EvalString As String
        With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
            EvalString = "Value(Right(" & .Address _
                & ",LEN(" & .Address & ")-" & Len(ID_PREFIX) & "))"
        End With
        IdNumbers = .Evaluate(EvalString)
    End With
    
    Dim IdNumber, MaxNumber As Long
    
    For Each IdNumber In IdNumbers
        If IsNumeric(IdNumber) Then
            If IdNumber > MaxNumber Then MaxNumber = IdNumber
        End If
    Next IdNumber
    
    Dim NewId As String: NewId = ID_PREFIX & CStr(MaxNumber   1)
    
    GetNewId = NewId

End Function

Your New Sub

Private Sub UserForm_Initialize()

    Me.Height = 424
    Me.Width = 438
    Me.Zoom = 100
    
    Txt_DateLogged.Value = Format(Date, "dd/mm/yyyy")
    Txt_Month.Value = Format(Date, "MMM-YY")
    
    Call CBO_Supplier_Items
    Call CBO_SRM_Items
    Call CBO_Cause_Items
    
    Me.Txt_IssueNum.Value = GetNewId

End Sub
  • Related