Sub FltrIt(Sh As Excel.Worksheet)
Dim oOle As OLEObject
Dim arr() As Variant, x As Integer, elm As Variant
Dim uRng As Range, Rng As Range, rw As Range, c As Range
With Sh
For Each oOle In Sh.OLEObjects
If oOle.progID = "Forms.CheckBox.1" _
And Not Intersect(.Range("A1:F1"), oOle.TopLeftCell) Is Nothing _
And oOle.Object.Value = True Then
x = x + 1
ReDim Preserve arr(1 To x)
arr(x) = oOle.TopLeftCell.Address(0, 0)
End If
Next oOle
Set uRng = .UsedRange
Set Rng = uRng.Offset(2).Resize(uRng.Rows.Count - 2)
Rng.EntireRow.Hidden = True
For Each rw In Rng.Rows
On Error GoTo errh
For Each elm In arr
Set c = .Range(elm)
If WorksheetFunction.CountIf(rw, c.Value) Then rw.EntireRow.Hidden = False
Next elm
On Error GoTo 0
Next rw
End With
errh:
If Err.Number Then Rng.EntireRow.Hidden = False
End Sub