The object invoked has disconnected from its clients

[rfletcher35]

Here is my code and has been working fine at the point it is now failing (in Bold). For some reason I am now getting the error message "The object invoked has disconnected from its clients" can someone please tell me why this is happening.

Once this has occurred it also crashes my workbook to which none of my VBA works and I have to use task manager to close and then re open it!

Help please!!!!

Sub Results()
'
' Results Macro
'
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Sheets("SAP Abence").Visible = True
    Sheets("MPR Data").Visible = True
    Sheets("Sheet3").Visible = True
    
    Dim rng365 As Range
    Dim CurMonth As Range
    
    Sheets("Results Sheet").Select
    Range("P5:BL3000").Select
    Selection.ClearContents
    
'   365 - 1 Year of Work No Absence
    Set CurMonth = Range("C2")
    With Sheets("MPR Data")
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="None", Operator:=xlFilterValues
    On Error GoTo Enditall
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    End With
If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("P5").PasteSpecial Paste:=xlPasteValues
Enditall:
    
End If
    Application.CutCopyMode = False
    
    With Sheets("MPR Data")
    .Range("$T$4:$AB$3150").AutoFilter Field:=6
    .Range("$T$4:$AB$3150").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=365", Operator:=xlFilterValues
    On Error GoTo Enditall1
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    End With
If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Enditall1:
End If
    
'   1 Month to Go
   ' Dim OneMonth As Range
    Sheets("MPR Data").Select
    Set CurMonth = Range("I2")
    With Sheets("MPR Data")
    .Range("$T$4:$AB$3150").AutoFilter Field:=6
    .Range("$T$4:$AB$3150").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="None", Operator:=xlFilterValues
    On Error GoTo Enditall2
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
End With
If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("AB5").PasteSpecial Paste:=xlPasteValues
    
Enditall2:
End If
    
    With Sheets("MPR Data")
    .Range("$T$4:$AB$3150").AutoFilter Field:=6
    .Range("$T$4:$AB$3150").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=365", Operator:=xlFilterValues
    On Error GoTo Enditall3
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    
End With
    If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("AB" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Enditall3:
        
End If
    Sheets("MPR Data").Select
    ActiveSheet.Range("$T$4:$AB$3150").AutoFilter Field:=6
    ActiveSheet.Range("$T$4:$AB$3150").AutoFilter Field:=1
    Sheets("Results Sheet").Select
    
    Range("A1").Select
    
    Sheets("SAP Abence").Visible = False
    Sheets("MPR Data").Visible = False
    Sheets("Sheet3").Visible = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
            
End Sub

 

[RoryA]

Why are you using a different range to the two previous lines?

 

[rfletcher35]

Didn't realise I was but I have altered it to the same and it still comes up with the same error?

Can't understand it as it was working fine I've not altered that part of the code at all.

 

[RoryA]

Then I guess my first question would be what has changed?

Do you have any forms or activex controls that are linked directly to any ranges?

 

[rfletcher35]

If I edit out the portion of code below it works up until the part in bold below where it appears that the code to say skip if blank is not working? The line in bold is where it now stops working!

'   1 Month to Go
   ' Dim OneMonth As Range
    'Sheets("MPR Data").Select
    'Set CurMonth = Range("I2")
    'With Sheets("MPR Data")
    '.Range("$T$4:$AB$4000").AutoFilter Field:=6
    '.Range("$T$4:$AB$4000").AutoFilter Field:=1
    '.Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    '.Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="None", Operator:=xlFilterValues
    'On Error GoTo Enditall2
   ' Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
'End With
'If Not rng365 Is Nothing Then
    'rng365.Copy
    'Sheets("Results Sheet").Range("AB5").PasteSpecial Paste:=xlPasteValues
    
'Enditall2:
'End If




With Sheets("MPR Data")
    .Range("$T$4:$AB$4000").AutoFilter Field:=6
    .Range("$T$4:$AB$4000").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=365", Operator:=xlFilterValues
    On Error GoTo SkipWithBlanks
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    
End With
    If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("AB" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
SkipWithBlanks:
        
End If

 

[RoryA]

First, please use code tags when posting code.

Second, what is the error message - the same?

 

[rfletcher35]

The only bit that has changed was that I've added the Enditall routine to avoid copying blanks after filtering. On the part where it is going wrong now if changed it to skipwithblanks but still has the same issue.

 

[RoryA]

What is the error message?

 

[rfletcher35]

Same error it hasn't changed and it crashes Excel but not VBA Editor, I can move around this until I save or try to do anything that effects my workbook then it also hangs.

The object invoked has disconnected from its clients

 

[RoryA]

Can you put a workbook somewhere for me to look at?