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
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:
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!
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With