Finding Highest Value in A Series of Text Values

[Ark68]

Consider this dynamic range of cells:

wloopkdata_13.xlsm
	P
1	44451W001
2	44451W002
3	44451W003
4	44451W004
5	44451W005
6	44451W006
7	44451S001
8	44451S002
9	44451S003
10	44451S004
11	44452W001
12	44452W002
13	44452W003
14	44452W004
15	44452W005
16	44452W006
Sheet1

I am looking for a VBA solution in which I can find the highest value of a particular seriers in that range.

For instance, if we assume a series being = 44451W, what is "x" - the largest value (determined by the last three numbers of the string) in that series. In this example, "x" = 6.

Thank you for yuour help!

 

[Marc L]

As the range is somewhat already sorted a VBA demonstration for starters :​

Sub Demo1()
     Const S = "44451W"
       Dim Rc As Range
       Set Rc = Range([P1], [P1].End(xlDown)).Find(S & "*", , , , , 2)
    If Not Rc Is Nothing Then
       MsgBox "The last is #" & Val(Replace(Rc.Text, S, "")), 64
       Set Rc = Nothing
    End If
End Sub

 

[bebo021999]

Range can be in any order.

Option Explicit
Sub HighestValue()
Dim Lr&, i&, max&, cell As Range, series As String, arr()
Lr = Cells(Rows.Count, "P").End(xlUp).Row
ReDim arr(1 To Lr, 1 To 1)
series = UCase(InputBox("Input series:"))
For Each cell In Range("P1:P" & Lr)
    If cell.Value Like series & "*" Then
        i = i + 1
        If i = 1 Then
            max = Mid(cell, Len(series) + 1, 255) + 0
        End If
        arr(i, 1) = Mid(cell, Len(series) + 1, 255) + 0
        If arr(i, 1) > max Then
           max = arr(i, 1)
        End If
    End If
Next
MsgBox "max value is: " & max
End Sub

 

[Marc L]

A variation of my demonstration :​

Sub Demo1v()
  Const S = "44451W"
    Dim V
        V = Filter(Evaluate("TRANSPOSE(P1:P" & Cells(Rows.Count, 16).End(xlUp).Row & ")"), S, True)
        If UBound(V) > -1 Then MsgBox "The last is #" & Val(Replace(V(UBound(V)), S, "")), 64
End Sub

 

[Ark68]

Thank you bebo021999 and Marc L for sharing your insight and skill. I adapted both to my needs to try. Unfortuantely Marc, I wasn't able to get results from your's, but that may be due in part to my adaptation efforts. bebo21999, your's did work wonderfully.

If interested, here are you versions adapted to my needs ..

Sub det_RID_1_a(ByRef RID As String) 'thank you Marc L
    Stop
    Dim v
    'ser_dt = ws_gui.Range("B4")
    ser_dt = 44588
    w_ctr = Left(wloc, 1)
    S = ser_dt & w_ctr
    
    With ws_ops
        v = Filter(Evaluate("TRANSPOSE(A2:A" & .Cells(.Rows.Count, 16).End(xlUp).Row & ")"), S, True)
        If UBound(v) > -1 Then MsgBox "The last is #" & Val(Replace(v(UBound(v)), S, "")), 64
    End With

'RID = Range("B4").Value & Left(wloc, 1) & Format(cnt_rid, "000")
End Sub

Sub det_RID(ByRef RID As String) 'thank you bebo21999
    Dim Lr&, i&, max&, cell As Range, series As String, arr()
    Stop
    With ws_ops
        Lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        ReDim arr(1 To Lr, 1 To 1)
        series = UCase(InputBox("Input series:"))
        For Each cell In .Range("A2:A" & Lr)
            If cell.Value Like series & "*" Then
                i = i + 1
                If i = 1 Then
                    max = Mid(cell, Len(series) + 1, 255) + 0
                End If
                arr(i, 1) = Mid(cell, Len(series) + 1, 255) + 0
                If arr(i, 1) > max Then
                   max = arr(i, 1)
                End If
            End If
        Next
    End With
    RID = series & Format(max + 1, "000")
    MsgBox "Next RID: " & RID
End Sub