XL2003 VBA: Run-time error -2147417848

[TechTank]

Hi All,

I have a macro assigned to a button and when I execute the following code more than twice (this is the macro assigned to the button) I get the following error message:

Microsoft Visual Basic
 
Run-time error '-2147417848 (80010108/)':
 
Method 'Insert' of object 'Range' failed

Macro Code:

Option Explicit
Sub Add_Static_Environment_Server()
Dim rng As Range
    
Application.DisplayAlerts = False
Application.ScreenUpdating = False
        
    Sheets("Format Control").Range("C9").Value = _
        Sheets("Cover Sheet").Range("B27").Value
        Sheets("Format Control").Range("E9").Value = _
        Sheets("Cover Sheet").Range("B23").Value
    With Sheets("Environment Information")
        .Unprotect
        Set rng = .Columns("A").Find(What:="1", After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, _
            MatchCase:=False, SearchFormat:=False)
        Sheets("Format Control").Rows(9).Copy
        rng.Offset(1).EntireRow.Insert
        rng.Offset(1, 3).Select
        
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
            AllowInsertingRows:=True, AllowDeletingRows:=True
    End With
    
    ActiveWindow.ScrollRow = 1
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

This used to work but can't quite figure out why it is displaying this error now.

Any help greatly appreciated.

Thanks.

 

[jim may]

Can you Post the code line of the highlighted error

 

[TechTank]

Unfortunately when I step through it manually holding down F8 it completes every time without fail. When I execute the macro from the button it errors. I have tried click on 'debug' but Excel announces that an error has occurred and it needs to restart and submit an error report.

Sorry. I've managed to find a stable previous version but all I'd added was a few macro's for filtering on a different page. Can't quite figure this one out :0|

 

[TechTank]

Hi All,

I think I've managed to isolate the code that maybe causing this error for me:

This is the sheet code that enables merged cells to auto-height (yes I have tried to avoid merged cells but in this case I can't unfortunately):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
ActiveSheet.Unprotect
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
         MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
     ma.MergeCells = False
      c.ColumnWidth = MrgeWdth
       c.EntireRow.AutoFit
        NewRwHt = c.RowHeight
       c.ColumnWidth = cWdth
     ma.MergeCells = True
    ma.RowHeight = NewRwHt
   cWdth = 0: MrgeWdth = 0
End If
End With
Application.ScreenUpdating = True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowDeletingRows:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
 
Call Unlock_Cells
End Sub

The Call Unlock_Cells calls the following macro:

Sub Unlock_Cells()
ActiveSheet.Unprotect
    Range("D" & Cells.Rows.Count).End(xlUp).Select
        Selection.Locked = False
        Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowDeletingRows:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

This was necessary to resolve the problem I had of a cell locking when it was auto-heightened (Please see this thread: http://www.mrexcel.com/forum/showthread.php?t=577434)

I believe it may be the Call or the code for the Unlock_Cells macro that is giving me the error but do not have enough knowledge to resolve.

If anybody can help or suggest another way I would be very grateful.

Thank you.

 

[TechTank]

Instead of having the Worksheet Code call a Macro at the end I was provided the solution by Andrew Poulsom (MrExcel.com MVP and Moderator) and it can be found here:

http://www.mrexcel.com/forum/showthread.php?t=577434&page=2

The Worksheet Code is now below (obviously I deleted the macro as it was no longer needed.) This code also gets rid of the error stated in the Title of this thread:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
 
Application.ScreenUpdating = False
 
ActiveSheet.Unprotect
 
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
         MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
     ma.MergeCells = False
      c.ColumnWidth = MrgeWdth
       c.EntireRow.AutoFit
        NewRwHt = c.RowHeight
       c.ColumnWidth = cWdth
     ma.MergeCells = True
    ma.RowHeight = NewRwHt
    ma.Locked = Flase
   cWdth = 0: MrgeWdth = 0
End If
End With
 
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowInsertingRows:=True, AllowDeletingRows:=True
 
Application.ScreenUpdating = True
 
End Sub

Thank you to all who replied and tried to help, you're all fantastic.