How to loop through a Letter and Number Sequence (I30112-J01111)

Question

I need to find multiple rows (usually 156) by searching for a string.

Example String: 'I30112' The I stands for September(9th letter in the alphabet), 30 stands for the 30th day in September, and the 112 stands for the 112th unit on the 30th day of September.

My user is going to say please find the next x units starting from I30112. This means I'll search for I30112,I30113 etc until I get to I30156. The unit after I30156 will be J01001. So I need to find from I30112 to J01111.

How do I make a loop to search from the bottom of the sheet finding the last reference to each of those units? If they were all in order I could just find one, and grab the next 156, but unfortunately they are not always in the correct order.

Thank you!

---Edit---

I'm trying to use the ASC() method. However, given that my user input is a variable, I am having difficulty getting the correct character. Currently I have:

Dim Month As String  
Dim MonthChar As Integer  

Month = Left(UserForm1.TextBox1.Value, 1)  
MonthChar = Asc(Month)

However, I get an error despite Month being a string. If I switch to Monthchar = Asc("Month") then it always grabs the M from Month instead of treating it as a variable.

Answer 1

I have the code for interactions on the worksheet.

Consider the below worksheet (Sheet4):

• the Units String in column A
• an equivalent number in column B by the FormulaR1C1
  =(CODE(RC[-1])-CODE("A")+1)*100000+VALUE(RIGHT(RC[-1],LEN(RC[-1])-1))
• a dynamic named range MDU_String:
  =OFFSET(Sheet4!$A$1,1,0,COUNTA(Sheet4!$A:$A)-1,1)
• 2 static named ranges:
  Lookup_from : =Sheet4!$E$1
For_units : =Sheet4!$G$1
  
• Data Validation on E1:
  

Now in worksheet module of Sheet4 (issues fixed):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target
        Case ThisWorkbook.Names("Lookup_from").RefersToRange, ThisWorkbook.Names("For_units").RefersToRange
            SetupFilter Target
    End Select
End Sub

Private Sub SetupFilter(ByVal Target As Range)
    Dim lUnits As Long, sLookup As String
    Dim oRng As Range, lFrom As Long, lTo As Long, lCount As Long, bStop As Boolean
    Dim lMonth As Integer, lDay As Integer, dNextDay As Date, iTry As Integer

    ResetFilter ' Remove AutoFilter
    Application.ScreenUpdating = False
    If Not IsEmpty(Target) Then
        sLookup = ThisWorkbook.Names("Lookup_from").RefersToRange.Value
        lUnits = ThisWorkbook.Names("For_units").RefersToRange.Value
        Debug.Print "Lookup " & lUnits & " from " & sLookup
        Set oRng = ThisWorkbook.Names("MDU_String").RefersToRange.Find(sLookup)
        If Not oRng Is Nothing Then
            lFrom = oRng.Offset(0, 1).Value ' Number equivalent
            lTo = lFrom
            lCount = 0
            iTry = 0
            dNextDay = Date
            bStop = False
            ' Start from the Lookup_for, locate the last unit to show
            Do
                Debug.Print "Looking for lTo: " & lTo & " (" & lCount & ")"
                Set oRng = ThisWorkbook.Names("MDU_String").RefersToRange.Offset(0, 1).Find(What:=CStr(lTo), LookIn:=xlValues, LookAt:=xlWhole)
                If oRng Is Nothing Then
                    lMonth = lTo \ 100000
                    lDay = lTo \ 1000 Mod 100
                    dNextDay = DateSerial(Year(Date), lMonth, lDay + 1) ' Move to next day
                    If Year(Date) = Year(dNextDay) Then
                        lMonth = Month(dNextDay)
                        lDay = Day(dNextDay)
                        lTo = lMonth * 100000 + lDay * 1000 + 1 ' Try 001 on next day
                        Debug.Print "Try next day lTo: " & lTo
                    Else
                        bStop = True
                    End If
                    iTry = iTry + 1
                    If iTry > 2 Then bStop = True
                Else
                    lTo = lTo + 1 ' Try next incremented unit
                    iTry = 0 ' Reset trying counter
                    lCount = lCount + 1
                End If
                bStop = (lCount >= lUnits) Or bStop
            Loop Until bStop
            Debug.Print "lFrom: " & lFrom & vbTab & "lTo: " & lTo
            ' Activate the filter
            Union(Range("MDU_String"), Range("MDU_String").Offset(0, 1)).AutoFilter Field:=2, Criteria1:=">=" & lFrom, Operator:=xlAnd, Criteria2:="<" & lTo
            Set oRng = Nothing
        End If
    End If
    Application.ScreenUpdating = True
End Sub

Private Sub ResetFilter()
    Union(Range("MDU_String"), Range("MDU_String").Offset(0, 1)).AutoFilter Field:=2
End Sub

This will allow you to have interactive AutoFilter based on the changes in E1 and G1. The maths behind it can be confusing, but it's there to make things most generic, no matter the roll over day or number of units in that day (up to 999 units).

Just haven't test on end of December for number of units that roll over to next year, so something you should look out for.

Sample result:

Answer 2

A couple of options:

.

1. Standard loop with array

---

Option Explicit

Public Sub findUnitsArray()
    Const COL           As Long = 1      'A
    Const START_UNIT    As Long = 112
    Const CRIT          As String = "I30"

    Dim ws As Worksheet, ur As Range, v As Variant, i As Long
    Dim totalFound As Long, msg As String

    Set ws = ActiveSheet
    Set ur = ws.UsedRange
    v = ur.Columns(COL)

    For i = 1 To ur.Rows.Count
        If InStr(v(i, 1), CRIT) > 0 Then
            If Val(Right(v(i, 1), 3)) >= START_UNIT Then         'compare last 3 characters
                totalFound = totalFound + 1
                msg = msg & v(i, 1) & ", "
            End If
        End If
    Next
    MsgBox "Found " & totalFound & " units:" & vbCrLf & vbCrLf & Left(msg, Len(msg) - 2)
End Sub

---

.

2. AutoFilter and visible areas

---

Public Sub findUnitsAutoFilter()
    Const COL           As Long = 1     'A
    Const START_UNIT    As Long = 112
    Const CRIT          As String = "=I30**"

    Dim ws As Worksheet, ur As Range, ar As Range, cel As Range
    Dim totalFound As Long, msg As String

    Set ws = ActiveSheet
    Set ur = ws.UsedRange

    ws.AutoFilterMode = False
    With ur
        .AutoFilter
        .AutoFilter Field:=COL, Criteria1:=CRIT, Operator:=xlAnd
        For Each ar In .Columns(COL).SpecialCells(xlCellTypeVisible).Areas
            For Each cel In ar
                If Val(Right(cel.Value2, 3)) >= START_UNIT Then  'compare last 3 characters
                    totalFound = totalFound + 1
                    msg = msg & cel.Value2 & ", "
                End If
            Next
        Next
    End With
    MsgBox "Found " & totalFound & " units:" & vbCrLf & vbCrLf & Left(msg, Len(msg) - 2)
End Sub

---

.

Answer 3

While your question gives no indication as to what to do with the values once you've found them, collecting a filtered collection of the appropriate encoded strings into a variant array and subsequently pushing them into the criteria of a AutoFilter Method seems the most expedient process.

Sub filter_for_encode_string()
    Dim str As String, enc As String, rw As Long
    Dim dt As Date, num As Long, dy As Long, ndy As Long, mn As String, nmn As String
    Dim v As Long, vFLTRs As Variant

    enc = "I30112"
    dt = DateSerial(Year(Date), Asc(Left(enc, 1)) - 64, Mid(enc, 2, 2))
    mn = Chr(Month(dt) + 64)
    dy = Day(dt)
    num = Val(Right(enc, 3))
    ndy = Day(dt + 1)
    nmn = Chr(Month(dt + 1) + 64)

    With Worksheets("Sheet4")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            ReDim vFLTRs(0)
            For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
                str = .Cells(rw, 1).Value2
                If (Left(str, 1) = mn And Val(Mid(str, 2, 2)) = dy And Val(Right(str, 3)) >= num) Or _
                   (Left(str, 1) = nmn And Val(Mid(str, 2, 2)) = ndy And Val(Right(str, 3)) < num) Then
                    vFLTRs(UBound(vFLTRs)) = .Cells(rw, 1).Value2
                    ReDim Preserve vFLTRs(UBound(vFLTRs) + 1)
                End If
            Next rw
            If UBound(vFLTRs) Then ReDim Preserve vFLTRs(UBound(vFLTRs) - 1)

            .Columns(1).AutoFilter Field:=1, Criteria1:=(vFLTRs), _
                                   Operator:=xlFilterValues, VisibleDropDown:=False       
            With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    'do something with the filtered range
                End If
            End With
            '.Columns(1).AutoFilter Field:=1
        End With
    End With
End Sub

There has be a little juggling to get the next day when you are starting on the last day of a month or year. Since the year is not specified, the current year is used to determine whether 29-Feb is a factor.

There are still a few things to deal with.

1. Getting the encoded string into the routine. Currently this is assigned with enc = "I30112".
2. There was no mention as to what you actually wanted to do with the filtered set once you retrieved it. I've left a commented area where the filtered set is within a With ... End With statement. Immediately after this there is a commented code line that removes the filter. Data ► Sort & Filter ► Clear will do the same thing.

Your narrative referred to 'usually 156'. The following finds the maximum 'unit' code for any given coded month and day.

=AGGREGATE(14, 6, RIGHT(A2:INDEX(A:A, MATCH("zzz",A:A )), 3)/(LEFT(A2:INDEX(A:A, MATCH("zzz",A:A )), 3)="I30"), 1)