Vba error -2147417848 (80010108) automation error

Closed
Tbonekiller Posts 17 Registration date Wednesday August 21, 2019 Status Member Last seen June 6, 2024 - Jan 13, 2020 at 09:23 AM
Tbonekiller Posts 17 Registration date Wednesday August 21, 2019 Status Member Last seen June 6, 2024 - Feb 10, 2020 at 01:48 PM
So I am trying to make a spreadsheet that tracks our usage by diameter and individual serial number. I perform some basic checks using conditional formatting on the data entry page before moving the data to it's own page for tracking purposes. I wrote a macro to perform all the copy and paste, sorting, formula writing, etc... so I could move through the data entry quicker and then assigned it to a button.

The problem I am having is I get a
"runtime error -2147417848 (80010108)
automation error
The object invoked has disconnected from its clients"

Now the part I can't seem to figure out is that this locks up excel usually and I have to ctrl-alt-del to task manager and close the excel task before I can get back into excel. Now I can get this error once (sometimes 3 or 4 times even) or not at all other times, but once I'm back into excel I reenter the same information and it works fine. So I can't pinpoint it to a certain diameter or group of information being entered. I'll list the code below and I'm sorry if there is an obvious way to do this easily, but I'm new to all this. So thank you for any help you can provide.

Sub update_die_info()
'
' update_die_info
' updates all sheets based on value of c11
'

'

'
'highlights info to copy

Sheets("Check out Sheet").Select
Range("A11:h11").Select
Selection.Copy

'pulls info from "C11" to activate appropriate sheet to move data to

find_sheet

'inserts information onto appropriate sheet

Range("A6").Select
Selection.Insert Shift:=xlDown
Range("A6:H6").Select ----------------------------(locks up here when it does)
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("A6").Select

'see description below for each macro listed below

clear_conditional_format_mic_readings
sort_date
total_of_dies_ran
total_coils_produced
Sheets("Check out Sheet").Select
Range("b11:g11").Select
Selection.ClearContents
Range("A11").Select
Save
End Sub

Sub find_sheet()
'
'
' finds appropriate sheet based on info in "C11"
'
'
'finds sheet name you want based on "C11"
sheetname = ThisWorkbook.Worksheets("Check out Sheet").Range("c11").Text
ThisWorkbook.Worksheets(sheetname).Activate



End Sub

Sub clear_conditional_format_mic_readings()
'
' clear_conditional_format_mic_readings Macro
' clear conditional format for mic readings
'
' Run first

'
Range("E6:H6").Select
Selection.FormatConditions.Delete
Range("A6").Select
End Sub

Sub sort_date()
'
' sort_date Macro
'
' run second after clear_conditional_format_mic_readings

'
Range("A6:h2505").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A6"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A6:h2505")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
End Sub

Sub total_of_dies_ran()
'
' total_of_dies_ran Macro
' finds how many dies have ran
'
' Run third after sort_date

'
ActiveSheet.Select
Range("B6:B2505").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-78
Range("K8").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("K7:K2507").RemoveDuplicates Columns:=1, Header:= _
xlYes
Range("a6").Select
End Sub

Sub total_coils_produced()
'
' total_coils_produced Macro
' writes formula for total coils produced
'
' Run fourth after total_of_dies_ran

'
ActiveSheet.Select
Range("L8").Select
ActiveCell.FormulaR1C1 = _
"=SUMIF(R[-2]C[-10]:R[2497]C[-10],RC[-1],(R[-2]C[-8]:R[2497]C[-8]))"
Range("L8").Select
Selection.AutoFill Destination:=Range("L8:L408"), Type:=xlFillDefault
Range("L8:L408").Select
ActiveWindow.SmallScroll Down:=-408
Range("A6").Select
End Sub

Sub Save()
'
' Save Macro
' Saves worksheet
'

'
ActiveWorkbook.Save
End Sub

Sub get_totals()

write_totals_by_month_formula
Hide_Rows
Save

End Sub

Sub Hide_Rows()
'
'this evaluates the information in column N and hides rows that have no coils produced and shows rows that have coils produced
'

BeginRow = 6
EndRow = 172
ChkCol = 14

For RowCnt = BeginRow To EndRow
If Cells(RowCnt, ChkCol).Value < 1 Then
Cells(RowCnt, ChkCol).EntireRow.Hidden = True
Else
Cells(RowCnt, ChkCol).EntireRow.Hidden = False
End If
Next RowCnt
End Sub

Sub write_totals_by_month_formula()
'
' write_totals_by_month_formula Macro
'

'
Sheets("7.49").Select
ActiveWindow.ScrollWorkbookTabs Sheets:=147
Sheets(Array("7.49", "7.50", "7.60", "7.70", "7.80", "7.90", "7.92", "8.00", "8.10", "8.20", _
"8.30", "8.40", "8.41", "8.50", "8.60", "8.70", "8.80", "8.90", "9.00", "9.10", "9.20", _
"9.30", "9.40", "9.50", "9.60")).Select
Sheets("7.49").Activate
Sheets(Array("9.70", "9.80", "9.90", "9.98", "10.00", "10.10", "10.20", "10.25", "10.30", _
"10.31", "10.40", "10.49", "10.50", "10.60", "10.70", "10.80", "10.90", "11.00", "11.10", "11.20" _
, "11.25", "11.30", "11.40", "11.50", "11.51")).Select Replace:= _
False
Sheets(Array("11.60", "11.70", "11.75", "11.80", "11.89", "11.90", "12.00", "12.05", "12.10", "12.20", _
"12.25", "12.30", "12.35", "12.40", "12.50", "12.55", "12.60", "12.70", "12.75", "12.80", "12.90" _
, "12.95", "13.00", "13.08", "13.10")).Select Replace:= _
False
Sheets(Array("13.20", "13.25", "13.30", "13.40", "13.49", "13.50", "13.60", "13.70", "13.72", "13.80", "13.85", "13.90", "13.97", "14.00", _
"14.05", "14.10", "14.15", "14.20", "14.25", "14.30", "14.35", "14.40", "14.48", "14.50", "14.60" _
)).Select Replace:= _
False
Sheets(Array("14.65", "14.68", "14.70", "14.75", "14.80", "14.85", "14.90", "15.00", "15.09", "15.10", "15.15", "15.20", "15.25", "15.30", "15.39", "15.40", _
"15.50", "15.60", "15.70", "15.75", "15.80", "15.85", "15.90", "15.95", "16.00")).Select Replace:= _
False
Sheets(Array("16.05", "16.10", "16.15", "16.20", "16.25", "16.30", "16.35", "16.40", "16.50", "16.60", "16.70", "16.75", "16.80", "16.85", "16.90", "17.00", _
"17.10", "17.20", "17.25", "17.30", "17.40", "17.50", "17.55", "17.60", "17.70")).Select Replace:= _
False
Sheets(Array("17.75", "17.80", "17.90", "18.00", "18.10", "18.15", "18.20", "18.25", "18.30", "18.40", "18.50", "18.60", "18.70", "18.75", "19.00", "19.75", _
"20.00")).Select Replace:=False
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C:R[2505]C)=1)*(R[5]C[3]:R[2505]C[3]))"
Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-1]:R[2505]C[-1])=2)*(R[5]C[2]:R[2505]C[2]))"
Range("C1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-2]:R[2505]C[-2])=3)*(R[5]C[1]:R[2505]C[1]))"
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-3]:R[2505]C[-3])=4)*(R[5]C:R[2505]C))"
Range("E1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-4]:R[2505]C[-4])=5)*(R[5]C[-1]:R[2505]C[-1]))"
Range("F1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-5]:R[2505]C[-5])=6)*(R[5]C[-2]:R[2505]C[-2]))"
Range("G1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-6]:R[2505]C[-6])=7)*(R[5]C[-3]:R[2505]C[-3]))"
Range("H1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-7]:R[2505]C[-7])=8)*(R[5]C[-4]:R[2505]C[-4]))"
Range("I1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-8]:R[2505]C[-8])=9)*(R[5]C[-5]:R[2505]C[-5]))"
Range("J1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-9]:R[2505]C[-9])=10)*(R[5]C[-6]:R[2505]C[-6]))"
Range("K1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-10]:R[2505]C[-10])=11)*(R[5]C[-7]:R[2505]C[-7]))"
Range("L1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R[5]C[-11]:R[2505]C[-11])=12)*(R[5]C[-8]:R[2505]C[-8]))"
Range("M1").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
Range("A6").Select
ActiveWindow.ScrollWorkbookTabs Sheets:=-148
Sheets("Summary Report").Select
Range("A1").Select
End Sub


I marked the line it errors out on, but this is the whole macro in case something else might possibly be causing it and I just don't realize it.
Related:

5 responses

Facebookcoder
Jan 13, 2020 at 09:50 AM
Anywhere you select a range, you need to select the tab or sheet first, or place the sheet name in the selection as in

Sheet1.range("a1:b3").select
0