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)
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-":
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