Vba code for getting first and last number from the list.

[satputenandkumar0]

Hi member,

I need a vba code to get the first and last number from the list (column b)for each series and each branch (column a).
Details about Heading
Branch code = codes of the braches
THC Number = Truck Hire Challan Number
I have attached file with desired output

[Solus Rankin]

try:

Sub Loopdyloop()

    Dim l As Long
    Dim lRow As Long
    Dim strSearch As String
    Dim strFirst1 As String
    Dim strLast1 As String
    Dim strFirst2 As String
    Dim strLast2 As String
    
    lRow = Range("A56635").End(xlUp).Row
    
    strSearch = InputBox("Select branch to search for")
    
    For l = 1 To lRow
        If Range("A" & l).Value = strSearch Then
            strFirst1 = Range("B" & l).Value
            Exit For
        End If
    Next l
    For l = 1 To lRow
        If Range("A" & l).Value = strSearch And Left(Range("B" & l), 1) = Left(strFirst1, 1) Then
            strLast1 = Range("B" & l).Value
        End If
    Next l
    For l = 1 To lRow
        If Range("A" & l).Value = strSearch And Left(Range("B" & l), 1) <> Left(strFirst1, 1) Then
            strFirst2 = Range("B" & l).Value
            Exit For
        End If
    Next l
    For l = 1 To lRow
        If Range("A" & l).Value = strSearch And Left(Range("B" & l), 1) = Left(strFirst2, 1) Then
            strLast2 = Range("B" & l).Value
        End If
    Next l
    
    Range("F2").Value = strFirst1
    Range("G2").Value = strLast1
    Range("F3").Value = strFirst2
    Range("G3").Value = strLast2
    
End Sub

[satputenandkumar0]

Dear XeRo Solus,

Sorry for late reply.
Your code works perfectly.
I have added reputation to you......
Thanks .........

[satputenandkumar0]

Dear Solus,

One little problem here. If THC series are more than two, third series not showing in output.
In some branches series are more than 5, then how can I get output there.

[satputenandkumar0]

Can Anybody do this?????????

[StephenR]

Why don't you add to your file an illustration of your problem? And don't bump two hours after your previous post!

[satputenandkumar0]

Dera StephenR,

sorry for dump post, I have attached file with problem.
Below is the modified code.

Sub Loopdyloop()
    Dim l As Long
    Dim lRow As Long
    Dim strSearch As String
    Dim strFirst1 As String
    Dim strLast1 As String
    Dim strFirst2 As String
    Dim strLast2 As String
    
    lRow = Range("A56635").End(xlUp).Row
    
    strSearch = InputBox("Select branch to search for")
    
    For l = 1 To lRow
        If Range("A" & l).Value = strSearch Then
            strFirst1 = Range("B" & l).Value
            Exit For
        End If
    Next l
    For l = 1 To lRow
        If Range("A" & l).Value = strSearch And Left(Range("B" & l), 5) = Left(strFirst1, 5) Then
            strLast1 = Range("B" & l).Value
        End If
    Next l
    For l = 1 To lRow
        If Range("A" & l).Value = strSearch And Left(Range("B" & l), 5) <> Left(strFirst1, 5) Then
            strFirst2 = Range("B" & l).Value
            Exit For
        End If
    Next l
    For l = 1 To lRow
        If Range("A" & l).Value = strSearch And Left(Range("B" & l), 5) = Left(strFirst2, 5) Then
            strLast2 = Range("B" & l).Value
        End If
    Next l
  
    
    
    Range("F2").Value = strFirst1
    Range("G2").Value = strLast1
    Range("F3").Value = strFirst2
    Range("G3").Value = strLast2

    
End Sub

[StephenR]

I think you need to clarify what defines a series. Is it the first three numbers after the S?

[satputenandkumar0]

Thanks StephenR,
You came for help......
Below is the desired output for attached file in post #7.

S1560981 S1560901
S1890001 S1890050
S1590001 S1590002
S1980444 S1980445
S6030898 S6030899

My English is not well .sorry

[StephenR]

Yes I understand that, but was asking you about the general principle. Anyway, here is a different approach:

Sub x()

Dim r As Range, r1 As Range, n As Long, ws1 As Worksheet, ws2 As Worksheet

Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error Resume Next
Sheets("Data").Delete
On Error GoTo 0
Set ws2 = Sheets.Add()
ws2.Name = "Data"

Set ws1 = Sheets("Sheet")
n = ws1.Range("A" & Rows.Count).End(xlUp).Row
ws1.Range("A1").Resize(n).AdvancedFilter xlFilterCopy, , ws2.Range("A1"), unique:=True
ws1.Range("B1").Resize(n).Copy ws2.Range("B1")
For Each r In ws2.Range("B2").Resize(n - 1)
    r = Left(r, 4)
Next r
ws2.Range("B1").Resize(n).AdvancedFilter xlFilterCopy, , ws2.Range("C1"), unique:=True
    
For Each r In ws2.Range("A2", ws2.Range("A" & Rows.Count).End(xlUp))
    For Each r1 In ws2.Range("C2", ws2.Range("C" & Rows.Count).End(xlUp))
        ws1.Range("F" & Rows.Count).End(xlUp)(2) = r
        ws1.Range("G" & Rows.Count).End(xlUp)(2).FormulaArray = "=MIN(IF(LEFT($B$2:$B$27,4)=" & Chr(34) & r1 & Chr(34) & ",IF($A$2:$A$27=" & Chr(34) & r & Chr(34) & ",VALUE(RIGHT($B$2:$B$27,LEN($B$2:$B$27)-1)))))"
        ws1.Range("H" & Rows.Count).End(xlUp)(2).FormulaArray = "=MAX(IF(LEFT($B$2:$B$27,4)=" & Chr(34) & r1 & Chr(34) & ",IF($A$2:$A$27=" & Chr(34) & r & Chr(34) & ",VALUE(RIGHT($B$2:$B$27,LEN($B$2:$B$27)-1)))))"
        ws1.Range("F2").CurrentRegion.Value = ws1.Range("F2").CurrentRegion.Value
    Next r1
Next r

Sheets("Data").Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

[satputenandkumar0]

Yesssss,

You done it...........
You are Genius!!!!!!!!!!!
I have added one more reputation to you

Thank you very much.

[satputenandkumar0]

Dear StephenR,

Sorry for long again,
but this code works if the branch code is same. But if Branch code changed then output takes extra Zeros.

pls check attached file.

Regards,
Nandkumar S.

[satputenandkumar0]

bump, Please