Autofilter, the object invoked has disconnected from its clients
Filter a Worksheet
Option Explicit
Private Sub CommandButton49_Click()
FilterWorksheet
End Sub
Sub FilterWorksheet()
Const ProcName As String = "FilterWorksheet"
On Error GoTo ClearError
Const sName As String = "DO NOT DELETE"
Const srgAddress As String = "BC3:BE50" ' ?
Const srrgAddress As String = "BD4:BD10" ' resize
Const scOffset As Long = 1 ' ('BE4:BE10')
Const dName As String = "Database"
Const drgAddress As String = "B23:BL71499"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range(srgAddress)
Dim srrg As Range: Set srrg = sws.Range(srrgAddress)
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
If dws.AutoFilterMode Then dws.AutoFilterMode = False
Dim drg As Range: Set drg = dws.Range(drgAddress)
Dim dhrg As Range: Set dhrg = drg.Rows(1)
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
srg.Calculate 'Refreshing "Category", "Apply All Data", "Match Lookup Value"
Dim sCell As Range
Dim sValue As Variant
Dim dField As Variant
For Each sCell In srrg.Cells
sValue = sCell.Value
If Not IsError(sValue) Then
If Len(CStr(sValue)) > 0 Then
dField = Application _
.Match(sCell.Offset(, scOffset).Value, dhrg, 0)
If IsNumeric(dField) Then
drg.AutoFilter Field:=dField, Criteria1:=sValue
End If
End If
End If
Next sCell
SafeExit:
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume SafeExit
End Sub
Well it seems that the problem was twofold, one that the Criteria needed to be a string and it was getting an integer back and secondly Operator:=xlFilterValues being placed after instructions with only a single variable was looked poorly upon by the excel gods.
In my case at least, this isn't a problem anymore. Hopefully this information helps someone else in the future!
Revised code:
Option Explicit
Private Sub CommandButton49_Click()
'
Dim Wsdnd As Worksheet
Set Wsdnd = Sheets("DO NOT DELETE")
Dim A0, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, ... (more variables) As Range
A4 = Wsdnd.Range("BD4").Value
A5 = Wsdnd.Range("BD5").Value
A6 = Wsdnd.Range("BD6").Value
A7 = Wsdnd.Range("BD7").Value
A8 = Wsdnd.Range("BD8").Value
... (More variables)
'
Wsdnd.Range("BC3:BE50").Calculate 'Refreshing "Category", "Apply All Data", "Match Lookup Value" Lists on DO NOT DELETE sheet
Application.Calculation = xlManual 'Restarts manual calculations only for workbook speed
'
'Filter #4
If Not IsEmpty(A6) Then
Sheets("Database").Range("B$24:BL$71499").AutoFilter Field:=WorksheetFunction.Match(Sheets("DO NOT DELETE").Range("BE6"), _
Worksheets("Database").Range("B23:BL23"), 0), Criteria1:=A6
Else
End If
'
'Filter #5
If Not IsEmpty(A7) Then
Sheets("Database").Range("B$24:BL$71499").AutoFilter Field:=WorksheetFunction.Match(Sheets("DO NOT DELETE").Range("BE7"), _
Worksheets("Database").Range("B23:BL23"), 0), Criteria1:=A7
Else
End If
'
'Filter #6
If Not IsEmpty(A8) Then
Sheets("Database").Range("B$24:BL$71499").AutoFilter Field:=WorksheetFunction.Match(Sheets("DO NOT DELETE").Range("BE8"), _
Worksheets("Database").Range("B23:BL23"), 0), Criteria1:=A8
Else
End If