Runtime Error '-2147417848 (80010108)'

I

Ian

Can anyone help me ... I keep getting the following message

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

The macro in question is listed below and is used to create and name
multiple worksheets by copying a template worksheet called 'TowerMaster'
based on a variable input list. This used to work perfectly until
yesterday... now it crashes after looping through the first time and creates
a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ?

The VBA code is listd below :

Option Explicit
Sub InitialTowerCreation()

Dim TowerName As Range
Dim NewTowerName As String
Dim iResponse As Integer

iResponse = MsgBox("This Macro should only be used once to create Tower
Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo)
'display statement to execute if ok
If iResponse = vbNo Then
MsgBox "You selected No"
Exit Sub
End If

If iResponse = vbYes Then
MsgBox "You selected Yes"
End If

Sheets("TowerMaster").Visible = True

For Each TowerName In PickLists.[List_Towers]
If TowerName <> "???" Then

NewTowerName = TowerName

Sheets("TowerMaster").Select
Application.CutCopyMode = False
Sheets("TowerMaster").Copy before:=Sheets("TowerMaster")
Sheets("TowerMaster (2)").Select
Sheets("TowerMaster (2)").Name = TowerName

Range("A6:A7").Select
ActiveCell.FormulaR1C1 = TowerName

ActiveWorkbook.Names.Add Name:="Data1_" & TowerName,
RefersToR1C1:= _
"=R11C1:R15C59"
ActiveWorkbook.Names.Add Name:="Data2_" & TowerName,
RefersToR1C1:= _
"=R27C1:R31C59"
ActiveWorkbook.Names.Add Name:="Data3_" & TowerName,
RefersToR1C1:= _
"=R43C1:R47C59"

'create Job Level Validation Range on sheet Job Levels
Sheets("Job Levels").Select
Rows("98:105").Select
Range("B98").Activate
Selection.Insert Shift:=xlDown

Range("Lev_MasterRng").Select
Selection.Copy


Rows("98:98").Select
ActiveSheet.Paste
Range("C98:C105").Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="Lev_" & TowerName,
RefersToR1C1:= _
"='Job Levels'!R98C3:R105C3"
Range("a98").Select
ActiveCell.FormulaR1C1 = TowerName

'create Job Level validation on Towersheet
Sheets("TowerMaster").Select
Calculate
Calculate
Sheets(NewTowerName).Select
Range("F11:F14,F16").Select
Range("F16").Activate
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=Lev_" & TowerName
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


Else
'do nothing
End If


On Error Resume Next

Next TowerName

Sheets("TowerMaster").Select
ActiveWindow.SelectedSheets.Visible = False
Calculate
Sheets("PickLists").Select

RefreshRates

End Sub


This used to work perfectly until yesterday... now it crashes after creating
the first new worksheet from the list ??
 
M

Martin Fishlock

Ian

I assume that there system is still the same.

It may be that the workbook code has got corrupted.

You could try exporting alll the code to a text file.

Deleteing all the modules and worksheet code if you have it and forms and
then importing them back in.

This may solve your problem

If you look here http://www.appspro.com/Utilities/CodeCleaner.htm Rob Bovey
has an excellent add-in that automates this entire process down to
a two mouse clicks.

--
Hope this helps
Martin Fishlock, Bangkok, Thailand
Please do not forget to rate this reply.


Ian said:
Can anyone help me ... I keep getting the following message

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

The macro in question is listed below and is used to create and name
multiple worksheets by copying a template worksheet called 'TowerMaster'
based on a variable input list. This used to work perfectly until
yesterday... now it crashes after looping through the first time and creates
a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ?

The VBA code is listd below :

Option Explicit
Sub InitialTowerCreation()

Dim TowerName As Range
Dim NewTowerName As String
Dim iResponse As Integer

iResponse = MsgBox("This Macro should only be used once to create Tower
Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo)
'display statement to execute if ok
If iResponse = vbNo Then
MsgBox "You selected No"
Exit Sub
End If

If iResponse = vbYes Then
MsgBox "You selected Yes"
End If

Sheets("TowerMaster").Visible = True

For Each TowerName In PickLists.[List_Towers]
If TowerName <> "???" Then

NewTowerName = TowerName

Sheets("TowerMaster").Select
Application.CutCopyMode = False
Sheets("TowerMaster").Copy before:=Sheets("TowerMaster")
Sheets("TowerMaster (2)").Select
Sheets("TowerMaster (2)").Name = TowerName

Range("A6:A7").Select
ActiveCell.FormulaR1C1 = TowerName

ActiveWorkbook.Names.Add Name:="Data1_" & TowerName,
RefersToR1C1:= _
"=R11C1:R15C59"
ActiveWorkbook.Names.Add Name:="Data2_" & TowerName,
RefersToR1C1:= _
"=R27C1:R31C59"
ActiveWorkbook.Names.Add Name:="Data3_" & TowerName,
RefersToR1C1:= _
"=R43C1:R47C59"

'create Job Level Validation Range on sheet Job Levels
Sheets("Job Levels").Select
Rows("98:105").Select
Range("B98").Activate
Selection.Insert Shift:=xlDown

Range("Lev_MasterRng").Select
Selection.Copy


Rows("98:98").Select
ActiveSheet.Paste
Range("C98:C105").Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="Lev_" & TowerName,
RefersToR1C1:= _
"='Job Levels'!R98C3:R105C3"
Range("a98").Select
ActiveCell.FormulaR1C1 = TowerName

'create Job Level validation on Towersheet
Sheets("TowerMaster").Select
Calculate
Calculate
Sheets(NewTowerName).Select
Range("F11:F14,F16").Select
Range("F16").Activate
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=Lev_" & TowerName
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


Else
'do nothing
End If


On Error Resume Next

Next TowerName

Sheets("TowerMaster").Select
ActiveWindow.SelectedSheets.Visible = False
Calculate
Sheets("PickLists").Select

RefreshRates

End Sub


This used to work perfectly until yesterday... now it crashes after creating
the first new worksheet from the list ??
Click to expand...
 
I

Ian

Martin,

thanks for suggestion, but still have the problem
--
Regards & Thanks


Martin Fishlock said:
Ian

I assume that there system is still the same.

It may be that the workbook code has got corrupted.

You could try exporting alll the code to a text file.

Deleteing all the modules and worksheet code if you have it and forms and
then importing them back in.

This may solve your problem

If you look here http://www.appspro.com/Utilities/CodeCleaner.htm Rob Bovey
has an excellent add-in that automates this entire process down to
a two mouse clicks.

--
Hope this helps
Martin Fishlock, Bangkok, Thailand
Please do not forget to rate this reply.


Ian said:
Can anyone help me ... I keep getting the following message

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

The macro in question is listed below and is used to create and name
multiple worksheets by copying a template worksheet called 'TowerMaster'
based on a variable input list. This used to work perfectly until
yesterday... now it crashes after looping through the first time and creates
a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ?

The VBA code is listd below :

Option Explicit
Sub InitialTowerCreation()

Dim TowerName As Range
Dim NewTowerName As String
Dim iResponse As Integer

iResponse = MsgBox("This Macro should only be used once to create Tower
Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo)
'display statement to execute if ok
If iResponse = vbNo Then
MsgBox "You selected No"
Exit Sub
End If

If iResponse = vbYes Then
MsgBox "You selected Yes"
End If

Sheets("TowerMaster").Visible = True

For Each TowerName In PickLists.[List_Towers]
If TowerName <> "???" Then

NewTowerName = TowerName

Sheets("TowerMaster").Select
Application.CutCopyMode = False
Sheets("TowerMaster").Copy before:=Sheets("TowerMaster")
Sheets("TowerMaster (2)").Select
Sheets("TowerMaster (2)").Name = TowerName

Range("A6:A7").Select
ActiveCell.FormulaR1C1 = TowerName

ActiveWorkbook.Names.Add Name:="Data1_" & TowerName,
RefersToR1C1:= _
"=R11C1:R15C59"
ActiveWorkbook.Names.Add Name:="Data2_" & TowerName,
RefersToR1C1:= _
"=R27C1:R31C59"
ActiveWorkbook.Names.Add Name:="Data3_" & TowerName,
RefersToR1C1:= _
"=R43C1:R47C59"

'create Job Level Validation Range on sheet Job Levels
Sheets("Job Levels").Select
Rows("98:105").Select
Range("B98").Activate
Selection.Insert Shift:=xlDown

Range("Lev_MasterRng").Select
Selection.Copy


Rows("98:98").Select
ActiveSheet.Paste
Range("C98:C105").Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="Lev_" & TowerName,
RefersToR1C1:= _
"='Job Levels'!R98C3:R105C3"
Range("a98").Select
ActiveCell.FormulaR1C1 = TowerName

'create Job Level validation on Towersheet
Sheets("TowerMaster").Select
Calculate
Calculate
Sheets(NewTowerName).Select
Range("F11:F14,F16").Select
Range("F16").Activate
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=Lev_" & TowerName
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


Else
'do nothing
End If


On Error Resume Next

Next TowerName

Sheets("TowerMaster").Select
ActiveWindow.SelectedSheets.Visible = False
Calculate
Sheets("PickLists").Select

RefreshRates

End Sub


This used to work perfectly until yesterday... now it crashes after creating
the first new worksheet from the list ??
Click to expand...
Click to expand...
 
M

Martin Fishlock

If you want to send me the workbook I can try looking at it on my system.

martin@fishlock @ yahoo.co.uk.cutthis remove the spaces and .cutthis.

--
Hope this helps
Martin Fishlock, Bangkok, Thailand
Please do not forget to rate this reply.


Ian said:
Martin,

thanks for suggestion, but still have the problem
--
Regards & Thanks


Martin Fishlock said:
Ian

I assume that there system is still the same.

It may be that the workbook code has got corrupted.

You could try exporting alll the code to a text file.

Deleteing all the modules and worksheet code if you have it and forms and
then importing them back in.

This may solve your problem

If you look here http://www.appspro.com/Utilities/CodeCleaner.htm Rob Bovey
has an excellent add-in that automates this entire process down to
a two mouse clicks.

--
Hope this helps
Martin Fishlock, Bangkok, Thailand
Please do not forget to rate this reply.


Ian said:
Can anyone help me ... I keep getting the following message

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

The macro in question is listed below and is used to create and name
multiple worksheets by copying a template worksheet called 'TowerMaster'
based on a variable input list. This used to work perfectly until
yesterday... now it crashes after looping through the first time and creates
a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ?

The VBA code is listd below :

Option Explicit
Sub InitialTowerCreation()

Dim TowerName As Range
Dim NewTowerName As String
Dim iResponse As Integer

iResponse = MsgBox("This Macro should only be used once to create Tower
Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo)
'display statement to execute if ok
If iResponse = vbNo Then
MsgBox "You selected No"
Exit Sub
End If

If iResponse = vbYes Then
MsgBox "You selected Yes"
End If

Sheets("TowerMaster").Visible = True

For Each TowerName In PickLists.[List_Towers]
If TowerName <> "???" Then

NewTowerName = TowerName

Sheets("TowerMaster").Select
Application.CutCopyMode = False
Sheets("TowerMaster").Copy before:=Sheets("TowerMaster")
Sheets("TowerMaster (2)").Select
Sheets("TowerMaster (2)").Name = TowerName

Range("A6:A7").Select
ActiveCell.FormulaR1C1 = TowerName

ActiveWorkbook.Names.Add Name:="Data1_" & TowerName,
RefersToR1C1:= _
"=R11C1:R15C59"
ActiveWorkbook.Names.Add Name:="Data2_" & TowerName,
RefersToR1C1:= _
"=R27C1:R31C59"
ActiveWorkbook.Names.Add Name:="Data3_" & TowerName,
RefersToR1C1:= _
"=R43C1:R47C59"

'create Job Level Validation Range on sheet Job Levels
Sheets("Job Levels").Select
Rows("98:105").Select
Range("B98").Activate
Selection.Insert Shift:=xlDown

Range("Lev_MasterRng").Select
Selection.Copy


Rows("98:98").Select
ActiveSheet.Paste
Range("C98:C105").Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="Lev_" & TowerName,
RefersToR1C1:= _
"='Job Levels'!R98C3:R105C3"
Range("a98").Select
ActiveCell.FormulaR1C1 = TowerName

'create Job Level validation on Towersheet
Sheets("TowerMaster").Select
Calculate
Calculate
Sheets(NewTowerName).Select
Range("F11:F14,F16").Select
Range("F16").Activate
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=Lev_" & TowerName
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


Else
'do nothing
End If


On Error Resume Next

Next TowerName

Sheets("TowerMaster").Select
ActiveWindow.SelectedSheets.Visible = False
Calculate
Sheets("PickLists").Select

RefreshRates

End Sub


This used to work perfectly until yesterday... now it crashes after creating
the first new worksheet from the list ??
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Pivot Table Error 1
Help again!!! 1
Run-time Error '-2147417848 (80010108)' 1
excel macro stops 0
Deleting blank (Cells/Rows) in Excel-VBA 1
Auto Send Email from Excel 2007 No Error when Outlook 2007 is full 0
"Subscript Out of Range" Error Question 2
Runtime Error -2147417848 (80010108) 0

Top