Maybe an if error statement is required.
Sub FilterAs()
Dim ws As Worksheet, sh As Worksheet
Dim r1 As Range, r2 As Range, rc As Range, fr As Range
Dim Rws As Long, Rng As Range, fRng As Range
Dim x, y, z
Set ws = Sheets("Sheet1")
Set sh = Sheets("Sheet2")
Set Lrng = ws.Range("B8:G12")
Set r1 = ws.Range("C2")
Set r2 = ws.Range("C3")
Set fr = ws.Range("B5")
Set rc = sh.Range("B2:L2").Find(what:=fr, lookat:=xlWhole)
With sh
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = .Range(.Cells(2, 1), .Cells(Rws, 1))
Rng.AutoFilter Field:=1, Criteria1:=">=" & r1, Operator:=xlAnd, Criteria2:="<=" & r2
On Error Resume Next
Set fRng = .Range(.Cells(3, rc.Column), .Cells(Rws, rc.Column)).SpecialCells(xlCellTypeVisible)
If fRng Is Nothing Then
MsgBox "No data to copy"
Else
x = Application.WorksheetFunction.Average(fRng)
y = Application.WorksheetFunction.Min(fRng)
z = Application.WorksheetFunction.Max(fRng)
fRng.Copy ws.Range("B8")
ws.Range("G13") = x
ws.Range("G14") = y
ws.Range("G15") = z
End If
.AutoFilterMode = 0
End With
End Sub
Bookmarks