Workbook Stop Working When Run VBA

G

GeoKoro13

New Member
Joined
Nov 24, 2016
Messages
27
Hi guys,

So, I have this huge problem!!!
When I run a vba for deleting all worksheets except 3 specified ones the excel stop working and close. This is a test file so, I don't mind about data but it seems that I can't help it.
There are three main sheets, Master_Sheet,Monthly_Report and Default. As you'll see from the codes below, I use the Default sheet as a template for the sheets I create to enter the data.

So, find below all the coding I use. I'm an amateur with macro so, the coding I use you might find very no-sense.

Code: 
Private Sub CommandButton1_Click()Worksheets("Default").Copy After:=Worksheets(Worksheets.Count)
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa


    '~~> Change CountLarge to Count if using xl2003
    If Target.Cells.CountLarge > 1 Then Exit Sub


    Application.EnableEvents = False


    If Not Intersect(Target, Range("B2")) Is Nothing Then
        Select Case Target.Value
        Case Is = "": Rows("6:71").EntireRow.Hidden = True
        Case Else: Rows("6:71").EntireRow.Hidden = False
        End Select
    End If
    
        If Not Intersect(Target, Range("B2")) Is Nothing Then
            Select Case Target.Value
        Case Is = "Mobil": Rows("39:47").EntireRow.Hidden = True


        End Select
    End If
        If Not Intersect(Target, Range("B2")) Is Nothing Then
            Select Case Target.Value
        Case Is = "Mobil": Rows("64:71").EntireRow.Hidden = True
        
        End Select
    End If
        If Not Intersect(Target, Range("B2")) Is Nothing Then
                Select Case Target.Value
        Case Is = "Viva": Rows("33:38").EntireRow.Hidden = True
        
        End Select
    End If
        If Not Intersect(Target, Range("B2")) Is Nothing Then
            Select Case Target.Value
        Case Is = "Viva": Rows("55:63").EntireRow.Hidden = True
        
        End Select
    End If


Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Address = "$E$8" And Range("E8") > 60 Then
Call SummurizeSheets
End If
If Target.Address = "$E$8" And Range("E8") > 300 Then
Call DeleteSheets1
End If
If Target.Address = "$E$8" And Range("E8") > 300 Then
Call CopySheet_End
End If
End Sub

Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)  If Not Intersect(Target, Range("A2:C14")) Is Nothing Then
    Sh.Name = Sh.Range("B1").Value
  End If
End Sub

Code: 
Function sheetname(number As Long) As String    sheetname = Sheets(number).Name
End Function

Code: 
Sub DeleteSheets1()    Dim xWs As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Master_Sheet" And xWs.Name <> "Monthly_Report" And xWs.Name <> "Default" Then
            xWs.Delete
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Code: 
Sub SummurizeSheets()    Dim ws As Worksheet
     
    Application.ScreenUpdating = False
    Sheets("Monthly_Report").Activate
     
    For Each ws In Worksheets
        If ws.Name <> "Monthly_Report" And ws.Name <> "Master_Sheet" And ws.Name <> "Default" Then
            ws.Range("B14").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("C14").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("B2").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("B4").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("D4").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("E4").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("A9").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 12).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("B9").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("C9").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 14).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("C12").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("D21").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("C23").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 17).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("D32").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 18).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("G12").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 19).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("H21").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 20).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("G23").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 21).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            ws.Range("H32").Copy
            Worksheets("Monthly_Report").Cells(Rows.Count, 22).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues


        End If
    Next ws
End Sub

Code: 
Sub CopySheet_End()Worksheets("Default").Copy After:=Worksheets(Worksheets.Count)
End Sub

I know it seems to much information but I guess for people like you it will be straight forward to understand.

If you have any idea why the file stop working when I use the
Code: 
DeleteSheets1
please let me know. Or if you have any idea how to correct the coding.

Thank you!!!
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
What happens if you disable events while deleting the sheets?
Code: 
Sub DeleteSheets1()    Dim xWs As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Master_Sheet" And xWs.Name <> "Monthly_Report" And xWs.Name <> "Default" Then
            xWs.Delete
        End If
    Next

    Application.EnableEvents = True 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks for the prompt reply.

What happened, which happened again when I change code, is it worked when I replace the code while the workbook was open. But when I saved it and reopened it (with you code saved) it crashed again when I run it.
Do you think the problem could be by cross-interaction of the codes or something else?
 
Upvote 0
How is Excel crashing?

Are you receiving any error messages?

What I suggested, disabling events, should stop any other code being triggered.

If that hasn't helped there could be something else going on.
 
Upvote 0
Not something specific.
There is message coming up say Micr Excel has stopped working and trying to retrieve the file but it fails..
 
Upvote 0
Norie said:
How is Excel crashing?

Are you receiving any error messages?

What I suggested, disabling events, should stop any other code being triggered.

If that hasn't helped there could be something else going on.
Click to expand...

What I just found by trial an error is when I remove coding for the command button (and the actual code) it doesn't crash.

This is the code I was using
Code: 
[COLOR=#333333]Private Sub CommandButton1_Click()Worksheets("Default").Copy After:=Worksheets(Worksheets.Count)[/COLOR]End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa


    '~~> Change CountLarge to Count if using xl2003
    If Target.Cells.CountLarge > 1 Then Exit Sub


    Application.EnableEvents = False


    If Not Intersect(Target, Range("B2")) Is Nothing Then
        Select Case Target.Value
        Case Is = "": Rows("6:71").EntireRow.Hidden = True
        Case Else: Rows("6:71").EntireRow.Hidden = False
        End Select
    End If
    
        If Not Intersect(Target, Range("B2")) Is Nothing Then
            Select Case Target.Value
        Case Is = "Mobil": Rows("39:47").EntireRow.Hidden = True


        End Select
    End If
        If Not Intersect(Target, Range("B2")) Is Nothing Then
            Select Case Target.Value
        Case Is = "Mobil": Rows("64:71").EntireRow.Hidden = True
        
        End Select
    End If
        If Not Intersect(Target, Range("B2")) Is Nothing Then
                Select Case Target.Value
        Case Is = "Viva": Rows("33:38").EntireRow.Hidden = True
        
        End Select
    End If
        If Not Intersect(Target, Range("B2")) Is Nothing Then
            Select Case Target.Value
        Case Is = "Viva": Rows("55:63").EntireRow.Hidden = True
        
        End Select
    End If


Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue [COLOR=#333333]End Sub[/COLOR]

Any idea how this could be the problem? Any suggestion how I could replace this function (I had on the Default sheet so I could just click it to create a copy of the sheet with coding)
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Paste Data Below last row
Replies
3
Views
210
rlv01
R
dreid1011
  • Question
Excel Crashing after Worksheet_Change code
Replies
1
Views
129
dreid1011
dreid1011
A
  • Solved
copy paste from one worksheet to other but in different columns
2
Replies
18
Views
700
Joe4
Joe4
D
  • Solved
Parsing a spreadsheet
Replies
9
Views
254
NdNoviceHlp
NdNoviceHlp
R
  • Solved
Update Cell if Source Workbook or Source Worksheet is Missing
Replies
7
Views
215
rlv01
R

Forum statistics

Threads
1,214,419
Messages
6,119,389
Members
448,891
Latest member
tpierce

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top