Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

"Automation Error: Object Invoked has disconnected from its clients"

Tags:

excel

vba

I figured out what Nick was suggesting, and the following is the error number & description that I'm getting:

'-2147417848 (80010108)' Automation error The object invoked has disconnected from its clients

The line of code that is highlighted when I debug is:

.Rows(Lst).Insert Shift:=xlDown

I thought that I had seen somewhere on this or another forum to unregister then re-register a specific file, but I was at home when I came across that, and didn't want to try it on my laptop, since everything already works 100% on it.

Once again, any help is greatly appreciated. I leave Sunday for 2 weeks, and I really need to get this working before I leave. Most of the people working for me are not excel guru's and need all buttons/functions working, as they won't be able to troubleshoot and/or work around the problems.

I am still sitting with the following code in a regular module, and the next set of code below that is in one of the worksheet modules.

 Sub add_InvRow()
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False

 switch = "off"

 With ThisWorkbook
  Dim wb As Excel.Workbook, Lst As Long
  Set wb = Application.ThisWorkbook
Dim ws As Worksheet, sw As Worksheet, os As Worksheet
   Set ws = ActiveSheet: Set sw = Application.Sheets(Sheet1.Name): Set os = Application.Sheets(Sheet4.Name)

  With ws
  Lst = ActiveCell.Row
  End With
 
   If ws.CodeName = "Sheet3" Then
 
  With os
   .Rows(213).Copy
  End With

  With ws
 

   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False
     
    venTabForm.Show
  End With
End If

If ws.CodeName = "Sheet23" Then
 
  With sw
   .Rows(135).Copy
  End With

  With ws
  
   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False
     
    cItemForm.Show
  End With
End If
 
 If ws.CodeName = "Sheet25" Then
 
 With sw
   .Rows(105).Copy
  End With

  With ws
   
   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False
     
   coInvForm.Show
  End With
 End If
 
 If ws.CodeName = "Sheet28" Then
      
  With sw
   .Rows(100).Copy
  End With
  
  With ws
   
   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False
     
   kInvForm.Show
  End With
End If

If ws.CodeName = "Sheet27" Then
  
  With sw
   .Rows(130).Copy
  End With
  
  With ws
     .Rows(Lst).Insert Shift:=xlDown
     Application.CutCopyMode = False
     
     ItemForm.Show
  End With
End If
 
If ws.CodeName = "Sheet22" Then
  
  With sw
   .Rows(120).Copy
  End With

  With ws
   
   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False
     
    caInvForm.Show
  End With
End If
 
 Set ws = Nothing: Set sw = Nothing: Set os = Nothing: Set wb = Nothing
End With

 switch = "on"
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
End Sub
  
  

This code is on one of the worksheets that has a command button, which calls the above code.

 Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If switch = "off" Then Exit Sub
 If Target.Address = "$H$1" Then
  Call findItem
 Exit Sub
 End If


If Application.Intersect(Target, Me.Range("P:P")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If Target.Cells.Value = 0 Or Target.Cells.Value = "" Then Exit Sub
Dim wb As Workbook, ws As Worksheet, iNUM As String, kitSHT As Worksheet, ksRNG As Range, kITEM As Range, kbCELL As Range
Dim iNAME As String, catSHT As Worksheet, csRNG As Range, cbCELL As Range, cITEM As Range
Dim logCELL As Range



Set wb = ThisWorkbook: Set ws = wb.Sheets(Sheet27.Name): Set kitSHT = wb.Sheets(Sheet28.Name): Set catSHT = wb.Sheets(Sheet22.Name)
Set ksRNG = kitSHT.Range("C5:C1100"): Set kbCELL = ksRNG.Cells(5, 3)
Set csRNG = catSHT.Range("C6:C400"): Set cbCELL = csRNG.Cells(6, 3)


 If (Not (Application.Intersect(Target, Me.Range("A:P")) Is Nothing)) And (Target.Cells.Count = 1) And (Target.Column = 16) Then
  If Target.Value = 0 Then Exit Sub
   iNUM = Target.Offset(, -12).Value
   iNAME = Target.Offset(, -10).Value

   If kitSHT.Cells.Find(What:=iNUM, After:=kbCELL, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) Is Nothing And _
  catSHT.Cells.Find(What:=iNUM, After:=cbCELL, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) Is Nothing Then



    MsgBox iNUM & "-" & iNAME & "" & " is not currently listed on" & " " & kitSHT.Name & " " & "or" & " " & catSHT.Name & vbNewLine & vbNewLine & _
              "Please add" & " " & iNUM & "-" & iNAME & "" & " to" & " " & kitSHT.Name & " " & _
               "or" & " " & catSHT.Name & " " & "and corresponding count sheets", vbInformation
               
  Set wb = Nothing: Set ws = Nothing: Set kbCELL = Nothing
  Set ksRNG = Nothing: Set kitSHT = Nothing: Set cbCELL = Nothing: Set catSHT = Nothing: Set csRNG = Nothing
  Exit Sub
 Else
If Target.Value = 0 Then Exit Sub
  premNUM = iNUM


 pFORM.Show
 End If
 End If

  Set wb = Nothing: Set ws = Nothing: Set kbCELL = Nothing
  Set ksRNG = Nothing: Set kitSHT = Nothing: Set cbCELL = Nothing: Set catSHT = Nothing: Set csRNG = Nothing


  Set ksRNG = Nothing: Set kitSHT = Nothing: Set cbCELL = Nothing: Set catSHT = Nothing: Set csRNG = Nothing
End Sub




 
like image 212
xlJunkie Avatar asked Mar 13 '23 22:03

xlJunkie


1 Answers

Ok... It's been well over 1 month now, and I've finally fixed this!! Fortunately & Unfortunately, it had absolutely nothing to do with my code. Instead, it was an MS Office Vs. Windows 8 problem. To fix it, I ran the compatability troubleshooter, and all is back to perfect again:

  1. Open MS Excel (Any File or new file)
  2. Pull up Task Manager
  3. Click on MS Office or Excel Icon in Background Processes, Right click, and select properties
  4. Under Compatibility, Click "Run Compatibility Troubleshooter"
  5. When finished running, test file again, if it works right, click apply settings to this program. If it doesn't work, click next and choose from the options. (I chose that it worked in previous version of Windows (Windows 7) Then click Next again.
  6. Test file again, and it worked.

I cannot believe that this is all I had to do the whole time! I actually spent $149 thinking that Microsoft Support could remote in and fix it, but that was an absolute waste! I was transferred to 12+ different people/departments, and still got nothing from them. I finally stumbled across the solution this morning....

Anyway, thanks to everyone who posted and tried to help me with this. I always log off of this site with better VBA skills than I signed on with because of all of you... So Thanks again!

like image 120
xlJunkie Avatar answered Apr 30 '23 14:04

xlJunkie