How to find the next highest Unit ID

[skittlz]

I have the data below, where I can have multiple Asset IDs:

In the sample above, I have 1 of E-017, 2 of E-027, 6 of E-258 and E169 in the list (not all are shown). I need a macro that'll identify the highest Unit ID number (and index by 1) if I enter a repeating (or new) Asset ID in column A. For example, if I enter E-258 in A8, it should enter "SN007" in B8. If I enter E-027 in A8, it should give me SN003 in B8. If I enter a new#, say E-99, in A8, it should give me SN001.

What's the most efficient and fastest way to search through 35k+ lines of data, and get the highest# for the next entry?

 

[Jeffrey Mahoney]

A macro could do that while monitoring changes in column A. It would search the entire list and place the next highest Unit ID

A formula could also be created, but if you sort the data, the Unit ID would change based on its position.

 

[skittlz]

A macro could do that while monitoring changes in column A. It would search the entire list and place the next highest Unit ID

A formula could also be created, but if you sort the data, the Unit ID would change based on its position.

I have this macro that uses an Array, but it dumps out the highest value in column D for ALL the assets - not what I need. Is there a way to search for and drop the highest value in column B for the latest entry?

Sub ExtractMaxPerEquipment()
 Dim ws As Worksheet, lastR As Long, arr, arrFin, i As Long, dict As Object
 
 Set ws = ActiveSheet 'use here the necessary sheet
 lastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row 'last row in A:A
 
 arr = ws.Range("A2:B" & lastR).Value2 'place the range in an array for faster processing
 
 Set dict = CreateObject("Scripting.Dictionary") 'set the necessary dictionary
 For i = 1 To UBound(arr) 'iterate between the array rows
    dict(arr(i, 1)) = Application.Max(endNo(CStr(arr(i, 2))), dict(arr(i, 1))) 'load the dictionary
 Next i
 
 arrFin = Application.Transpose(Array(dict.keys, dict.Items)) 'combine the dictionary keys and items in an array
 
 ws.Range("D2").Resize(UBound(arrFin), 2).Value2 = arrFin 'drop the final array content in "D2"
End Sub

Function endNo(x As String) As String
    If x = "" Then endNo = 0: Exit Function
    With CreateObject("vbscript.regexp")
        .Pattern = "\d{1,5}?.*$"
        .Global = False
        endNo = .Execute(x)(0)
    End With
End Function

 

[Jeffrey Mahoney]

Use this code. It needs to be placed in the SHEET level module for the sheet you have your table there.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Range
  Dim AssetID As String
  Dim AssetIDRng As Range
  Dim Cel As Range
  Dim CC As Range
  Dim MaxUnitID As Long
  Dim TempUID As String
  Dim UIDVal As Long
  
  Set i = Intersect(Range("A:A"), Target)
  
  If Not i Is Nothing Then
    Application.EnableEvents = False
    Set AssetIDRng = Range(Range("A1"), Range("A1000000").End(xlUp))
    
    For Each CC In i
      If CC.Value <> "" Then
        AssetID = CC.Value
        If CC.Offset(0, 1).Value = "" Then
          MaxUnitID = 0
          For Each Cel In AssetIDRng
            If Cel.Value = AssetID Then
              TempUID = Cel.Offset(0, 1).Value
              If UCase(Left(TempUID, 2)) = "SN" Then
                UIDVal = Mid(TempUID, 3, 100)
                If UIDVal > MaxUnitID Then MaxUnitID = UIDVal
              End If
            End If
          Next Cel
          CC.Offset(0, 1).Value = "SN" & Format(MaxUnitID + 1, "000")
        End If
      End If
    Next CC
    Application.EnableEvents = True
  End If
    
End Sub