Workbook Stop Working When Run VBA

GeoKoro13 · #1 11-30-2016, 09:59 PM

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.

So, I'm using the Default sheet as template from which I create copies. The default sheet a a ActiveX combo button to create copies of itself. Obviously, its copies have the combo button as well.

When this button exists, if I run the DeleteSheet1 Code I get the Excel Has stopped working... without more information. If you have any idea why the file stop working please let me know.

Thank you!!!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Excel 2013 hyperlinks stop working	dharris	Excel	0	03-22-2015 05:34 AM
All Office products stop working	lethlean	Office	1	05-18-2013 07:07 AM
Save As cause app to stop working	rafterman	Word	1	03-04-2013 11:20 PM
GIF's stop working	Kwarior	PowerPoint	3	03-17-2010 09:59 PM
Select a range in one one workbook while working in other workbook	Slow&Steady	Excel	1	02-21-2010 03:34 AM