CODEWITHSUNDEEP
excelvba
Fah
Fah

Reputation: 203

Excel file crash and closes sometimes when running a code, how to prevent it?

I have a simple code to copy and paste all the content from 1 sheet in another sheet and most of the time after the code finish to run the excel file closes and open again (but with no information).

The code is been called from a CommandButton1 inside a userform. I am put the code in the user form due to I am using a listbox to select the correct sheet to copy the information. 

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.EnableEvents = False 'For less lag

Application.Calculation = xlCalculationManual

Dim sheet_name As String
Dim oShape As Shape

Alert.Rows("15:" & Rows.count).ClearContents

 Alert.Activate

For Each oShape In ActiveSheet.Shapes
    If Not Application.Intersect(oShape.TopLeftCell, ActiveSheet.Rows("15:" & Rows.count)) Is Nothing Then
        oShape.Delete
    End If
Next

Dim i As Integer, sht As String
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sht = ListBox1.List(i)
        End If
    Next i
    Sheets(sht).Activate

    Application.EnableEvents = False

ActiveSheet.Range("A15:L345").Copy Alert.Range("A15")
Alert.Range("C1:C2").Value = ActiveSheet.Range("C1:C2").Value
Alert.Range("H2:L3").Value = ActiveSheet.Range("H2:L3").Value
Alert.Range("H5:L10").Value = ActiveSheet.Range("H5:L10").Value

Alert.Range("B34") = ActiveSheet.Name

ActiveSheet.Delete

 Call rename

 Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.EnableEvents = True

End Sub

The rename sub is a simple code as well.

Sub rename()

Dim ws As Worksheet

Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.EnableEvents = False 'For less lag

Alert.Activate

Alert.Name = Alert.Range("B34")
Alert.Range("B34") = ""

Range("L2:L3").Select
Range("L5:L10").Select
With Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
           End With
     With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
           End With

Alert.Range("A1").Activate

Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.EnableEvents = True

End Sub

How can I prevent it to crash?

Upvotes: 0

Views: 437

Answers (2)

Fah
Fah

Reputation: 203

Here is a simpleminded version of the code and it seems to stop the excel from crashing. 

Private Sub CommandButton1_Click()


Dim sheet_name As String
Dim oShape As Shape

Alert.Rows("15:" & Alert.Rows.count).ClearContents

Alert.Activate
DoEvents
For Each oShape In Alert.Shapes
    If Not Application.Intersect(oShape.TopLeftCell, Alert.Rows("15:" & Alert.Rows.count)) Is Nothing Then
        oShape.Delete
    End If
Next

Dim i As Integer, sht As String
DoEvents
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sht = ListBox1.List(i)
        End If
    Next i

    Application.EnableEvents = False

Sheets(sht).Range("A15:L345").Copy Alert.Range("A15")
Alert.Range("C1:C2").Value = Sheets(sht).Range("C1:C2").Value
Alert.Range("H2:L3").Value = Sheets(sht).Range("H2:L3").Value
Alert.Range("H5:L10").Value = Sheets(sht).Range("H5:L10").Value


Application.EnableEvents = False

Sheets(sht).Delete
Alert.Name = sht

Application.EnableEvents = False

DoEvents
With Alert.Range("L5:L10")
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
 End With
DoEvents
With Alert.Range("L2:L3")
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
 End With

Application.EnableEvents = True

End Sub

Upvotes: 1

TourEiffel
TourEiffel

Reputation: 4414

I would suggest use of DoEvents and also to avoid select & activate

    Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False: Application.DisplayAlerts = False: 
    Application.AskToUpdateLinks = False: Application.EnableEvents = False 'For less lag

    Application.Calculation = xlCalculationManual

    Dim sheet_name As String
    Dim oShape As Shape

    Alert.Rows("15:" & Rows.count).ClearContents

    Alert.Activate
    DoEvents
    For Each oShape In Alert.Shapes
    If Not Application.Intersect(oShape.TopLeftCell, Alert.Rows("15:" & Alert.Rows.count)) Is Nothing Then
            oShape.Delete
        End If
    Next

    Dim i As Integer, sht As String
    DoEvents
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                sht = ListBox1.List(i)
            End If
        Next i

        Application.EnableEvents = False

    Sheets(sht).Range("A15:L345").Copy Alert.Range("A15")
    Alert.Range("C1:C2").Value = Sheets(sht).Range("C1:C2").Value
    Alert.Range("H2:L3").Value = Sheets(sht).Range("H2:L3").Value
    Alert.Range("H5:L10").Value = Sheets(sht).Range("H5:L10").Value

    Alert.Range("B34") = Sheets(sht).Name

    Sheets(sht).Delete

     Call rename

     Application.Calculation = xlCalculationAutomatic

    Application.ScreenUpdating = True: Application.DisplayAlerts = True: 
    Application.AskToUpdateLinks = True: Application.EnableEvents = True

    End Sub


    Sub rename()

    Dim ws As Worksheet

    Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.EnableEvents = False 'For less lag


    Alert.Name = Alert.Range("B34")
    Alert.Range("B34") = ""

    DoEvents
With Alert.Range("L5:L10")
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
 End With
DoEvents
With Alert.Range("L2:L3")
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
 End With

    Application.ScreenUpdating = True: Application.DisplayAlerts = True: 
    Application.AskToUpdateLinks = True: Application.EnableEvents = True

    End Sub

Upvotes: 1

Related Questions