0

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?

Darren Bartrup-Cook
  • 18,362
  • 1
  • 23
  • 45
Fah
  • 207
  • 3
  • 16
  • 2
    Get rid of the `.Select` would be the first step: [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). This produces an unnecessary overload and makes your code slow and un-reliable. – Pᴇʜ May 12 '20 at 09:49
  • set application.calculation = manual , application.screenupdating = false then at the end turn it back ON. – Canute May 12 '20 at 09:54
  • @Canute I did here `Private Sub CommandButton1_Click() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.EnableEvents = False 'For less lag Application.Calculation = xlCalculationManual` **and in the end** `Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.EnableEvents = True` but it still crash – Fah May 12 '20 at 10:01
  • @Peh are you saying if I change the selection on Rename sub it may stop to crash? – Fah May 12 '20 at 10:03
  • 1
    If this happens `most of the time` this would mean that the code itself does not have evident bugs, but Excel needs more resources then available. In order to make it saving resources, do what @PEH already suggested. Useless selections consume resources. Start with `Sheets(sht).Activate`, please. Use `Dim sh as Worksheet` and then `Set sh = Sheets(sht)`. Then use `sh.Range("A15:L345").Copy Alert.Range("A15")` instead of `ActiveSheet.Range("A15:L345").Copy Alert.Range("A15")` and so on. Do similar in the other sub: `With Range("L5:L10")` instead of `With Selection` and so on... – FaneDuru May 12 '20 at 10:06
  • Oops, I missed that.... Can you step in the code and locate the exact line of failure? Also check if the sheet you are deleting is not the only sheet in the workbook? – Canute May 12 '20 at 10:39
  • @Canute, The code run and copy and paste all the information from 1 sheet to another. However, after the code run it crash the excel straight away. – Fah May 12 '20 at 10:41

2 Answers2

1

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
Fah
  • 207
  • 3
  • 16
TourEiffel
  • 4,034
  • 2
  • 16
  • 45
  • 1
    You should also avoid `.Activate` and `ActiveSheet` : `For Each oShape In Alert.Shapes` and `Alert.Rows("15:" & Alert.Rows.count)` – Pᴇʜ May 12 '20 at 10:23
  • 1
    And in the `rename()` the `Alert.Activate` should not be needed and this range `With Range("L5:L10")` has no sheet. So: `With Alert.Range("L5:L10")` and `With Selection` should not be used too. Also `Alert.Range("A1").Activate` is very likely not needed. – Pᴇʜ May 12 '20 at 10:26
  • 2
    no, `Rows("15:" & Rows.count)` is now referring to `ActiveSheet`. **Always specify a sheet!** it must be `Alert.Rows("15:" & Alert.Rows.count)` never use any `Range`, `Cells`, `Rows`, or `Columns` object without a sheet. And `With Range("L5:L10")` is still missing a sheet name too! It should be `With Alert.Range("L5:L10")` – Pᴇʜ May 12 '20 at 10:35
  • I am confused about this part `Alert.Activate DoEvents For Each oShape In Shapes If Not Application.Intersect(oShape.TopLeftCell, Rows("15:" & Rows.count)) Is Nothing Then oShape.Delete End If` The excel file is still crashing – Fah May 12 '20 at 10:51
  • @Fah Use debugger to see where your code does crash – TourEiffel May 12 '20 at 13:23
  • @Dorian that is the thing, the code is ruining until the end it does select the sheet through the userform listbox.. it copy and paste all the information from this sheet to another sheet, it deletes the "old sheet" (the sheet it used to copy the information), after the code run (and do everything that the code is "asking to" the excel just close. – Fah May 12 '20 at 14:06
  • If I would use more DoEvents would it make the code to run a bit more slow? When I am running the code on F8 it do not crash after running the code (it doe snot close the excel file). – Fah May 12 '20 at 15:43
  • 1
    @Fah You can use DoEvents Before each loop if needed but it can slow up the execution of your code. Kindest regards ( Why did you unaccept the answer ?) – TourEiffel May 13 '20 at 09:05
  • @Dorian Because it continue to crash the excel, the code is working just fine, but after it runs till the end it closes the excel with no reason (I debug and I cant find why it is happening), I try a more simple version of the code a it Seems to be working and not crashing the excel so far, however, I will test it more later. – Fah May 13 '20 at 10:00
  • @Fah What did you change to avoid excel's crash ? – TourEiffel May 13 '20 at 12:56
  • @Dorian I took off this parts `Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.EnableEvents = False 'For less Application.Calculation = xlCalculationManual` I just left only `Application.EnableEvents = False and True` I changed here ` Alert.Rows("15:" & Rows.count).ClearContents` .. `Sheets(sht).Delete Alert.Name = sht` .. .. And for some reason that I not sure it worked and excel is not crashing anymore. I think it become more clear for macros which sheet I want to do the events. – Fah May 15 '20 at 13:53
1

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
Fah
  • 207
  • 3
  • 16
  • 1
    Note that you could change `Alert.Range("L5:L10")` into `Alert.Range("L5:L10,L2:L3")` and remove the complete `With` block `With Alert.Range("L2:L3")`. Should be faster then. Also it might be possible to remove the `DoEvents` (check it out). Finally only one `Application.EnableEvents = False` line is enough (keep only the first one) as it does not turn on magically again. – Pᴇʜ May 13 '20 at 08:24