Extract data based on sheet name & two dates

Kalil

The problem occurs when your (undeclared) variable a is a single element array (i.e. if there's just one Total in the filtered date range). Using Transpose to determine the second (row_num) argument of the Index worksheet function (in the line cited in your Question) causes VBA to fail.

In the attached modified file, the button is relabelled "Extract" and assigned to the module procedure test below. Data validation is added to G" (to make sheet selection easier and avoid error if typed incorrectly)

That code is modified to cater for when a covers several totals or there's just one. A new variable RwNum is used to do that. Also it allows for when no totals are found. See changes and comments in bold below:

Sub test()

    Dim ws As Worksheet, ShName$, DateFrom&, DateTo&
    Dim a As Variant, b As Variant, RwNum As Variant

    Set ws = Sheets("SH2")
    ShName = ws.[G2]
    DateFrom = ws.[C2]
    DateTo = ws.[E2]

    If ShName = "" And DateFrom = 0 And DateTo = 0 Then
        ws.[A4].CurrentRegion.Offset(1).Clear
        Exit Sub
    End If

    With Sheets(ShName).[A1].CurrentRegion.Columns(1)
        If DateFrom = 0 Or DateTo = 0 Then
            a = Filter(.Parent.Evaluate(Replace("transpose(if(@=""Total"",row(@),0))", "@", .Address)), 0, 0)
        Else
            a = Filter(.Parent.Evaluate(Replace("transpose(if(((@)=""Total"")*(offset(@,,1)>=" & DateFrom & ")*(offset(@,,1)<=" & DateTo & "),row(@),0))", "@", .Address)), 0, 0)
        End If

        If UBound(a) < 0 Then
        ' if no records, say and quit
            MsgBox "No records in that date range for sheet " & ShName
            Exit Sub
        End If

        ' otherwise determine RwNum dependent on the number of Totals
        If UBound(a) > 0 Then
            ' if more than 1, create an array
            RwNum = Application.Transpose(a)
            Else
            ' if there's one, make it that value
            RwNum = a(0)
        End If

        b = .Parent.[A1].CurrentRegion.Value
    End With

    With ws
        .[A4].CurrentRegion.Offset(1).Clear
        With .Range("A" & Rows.Count).End(3)(2)
            ' use RwNum as second argument of Index
            .Offset(, 1).Resize(UBound(a) + 1, 3) = Application.Index(b, RwNum, [{2,4,10}])
            .Resize(UBound(a) + 1) = Evaluate("row(1:" & UBound(a) + 1 & ")")
        End With
        With .Range("A" & Rows.Count).End(3)(2)
            .Value = "Total"
            .Offset(, 3) = "=sum(d5:d" & .Row - 1 & ")"
            With .CurrentRegion
                .Borders.LineStyle = 1
                .HorizontalAlignment = xlCenter
                .Columns(4).NumberFormat = "#,0.00"
            End With
        End With
    End With

End Sub

The code should now work well in all cases. If so, please remember to mark this Answer as Selected.

Note: other users of this Forum may be puzzled by lines like:

        With .Range("A" & Rows.Count).End(3)(2)

.Note that the portion .Range("A" & Rows.Count).End(3) equates to the perhaps more familiar:

Range("A" & Rows.Count).End(xlUp)

so a range equal to the last used cell in column A and the additional (2) gives the "second" row from that range i.e. the cell BELOW the last used one, and so equivalent to:

        With .Range("A" & Rows.Count).End(xlUp).Offset(1,0))