Error showing if range contain different series

Hi members,

I got below vba code from Master xld (vbaexpress).


In Raw Data Sheet

Branch code in column A
Documents numbers in column b

Given VBA code is calculating From & To document numbers for each branch in Output sheet.
The code is working fine. But below points should be improve

• If any branch contain more than one series then this code giving error.
• If missing numbers are more that one these all numbers not showing.
• If any branch has only one document number it is showing missing same.

Public Sub CreateOuput() 
    Const FORMULA_BATCH_50 As String = "=SUMPRODUCT(--(RIGHT('Raw Data'!B<start>:B<end>,2)=""50""))" 
    Const FORMULA_BATCH_100 As String = "=SUMPRODUCT(--(RIGHT('Raw Data'!B<start>:B<end>,2)=""00""))" 
    Const FORMULA_MIDDLE_50 As String = "=MATCH(--(LEFT(B<start>,LEN(B<start>)-2)&""50""),B1:B<end>,0)" 
    Const FORMULA_MIDDLE_100 As String = "=MATCH(--(LEFT(B<start>,LEN(B<start>)-2)&""00""),B1:B<end>,0)" 
    Const FORMULA_MISSING As String = "=MIN(IF(NOT(ISNUMBER(MATCH(ROW(INDIRECT(RIGHT(B<start>,4)&"":""&RIGHT(B<end>,4))),--(RIGHT(B<start>:B<end>,4)),0)))," & _ 
    "--(LEFT(B<start>,LEN(B<start>)-4)&TEXT(ROW(INDIRECT(RIGHT(B<start>,4)&"":""&RIGHT(B<end>,4))),""0000""))))" 
    Dim ws As Worksheet 
    Dim branch As String 
    Dim firstTHC As Long 
    Dim middleTHC As Long 
    Dim lastTHC As Long 
    Dim missingTHC As Long 
    Dim nextrow As Long 
    Dim lastrow As Long 
    Dim i As Long 
     
    Application.DisplayAlerts = False 
    Worksheets("Output").Delete 
    Application.DisplayAlerts = True 
    With ActiveSheet 
         
        Set ws = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)) 
        ws.Name = "Output" 
        ws.Range("A1:D1").Value = Array("Bkg Branch", "From", "To", "Missing") 
         
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 
        nextrow = 2 
        branch = .Range("A2").Value 
        For i = 2 To lastrow + 1 
             
            If .Cells(i, "A").Value <> "branch" Then 
                 
            End If 
             
            firstTHC = i 
            Do 
                i = i + 1 
            Loop Until .Cells(i, "A").Value <> branch Or i > lastrow + 1 
            lastTHC = i - 1 
            If .Evaluate(Replace(Replace(FORMULA_BATCH_50, "<start>", firstTHC), "<end>", lastTHC)) Then 
                 
                middleTHC = .Evaluate(Replace(Replace(FORMULA_MIDDLE_50, "<start>", firstTHC), "<end>", lastTHC)) 
            ElseIf .Evaluate(Replace(Replace(FORMULA_BATCH_100, "<start>", firstTHC), "<end>", lastTHC)) Then 
                 
                middleTHC = .Evaluate(Replace(Replace(FORMULA_MIDDLE_100, "<start>", firstTHC), "<end>", lastTHC)) 
            Else 
                 
                middleTHC = 0 
            End If 
            If middleTHC > 0 Then 
                 
                .Cells(firstTHC, "A").Resize(, 2).Copy ws.Cells(nextrow, "A") 
                ws.Cells(nextrow, "C").Value = .Cells(middleTHC, "B").Value 
                .Range("F1").FormulaArray = Replace(Replace(FORMULA_MISSING, "<start>", firstTHC), "<end>", middleTHC) 
                If .Range("F1").Value > 0 Then ws.Cells(nextrow, "D").Value = .Range("F1").Value 
                nextrow = nextrow + 1 
                 
                .Cells(middleTHC + 1, "A").Resize(, 2).Copy ws.Cells(nextrow, "A") 
                ws.Cells(nextrow, "C").Value = .Cells(lastTHC, "B").Value 
                .Range("F1").FormulaArray = Replace(Replace(FORMULA_MISSING, "<start>", middleTHC), "<end>", lastTHC) 
                If .Range("F1").Value > 0 Then ws.Cells(nextrow, "D").Value = .Range("F1").Value 
                nextrow = nextrow + 1 
                 
                branch = .Cells(i, "A").Value 
            Else 
                 
                .Cells(firstTHC, "A").Resize(, 2).Copy ws.Cells(nextrow, "A") 
                ws.Cells(nextrow, "C").Value = .Cells(lastTHC, "B").Value 
                .Range("F1").FormulaArray = Replace(Replace(FORMULA_MISSING, "<start>", firstTHC), "<end>", lastTHC) 
                If .Range("F1").Value > 0 Then ws.Cells(nextrow, "D").Value = .Range("F1").Value 
                nextrow = nextrow + 1 
                 
                branch = .Cells(i, "A").Value 
            End If 
            If i < lastrow Then i = i - 1 
        Next i 
         
        .Range("F1").ClearContents 
    End With 
End Sub

Here I have attached file with desired output.

This thread is alive @ http://www.vbaexpress.com/forum/show...in-given-range But there is not response since 2-3 days.

Thanks in advance