Microsoft Office Forums - View Single Post - [Solved] Workbook Stop Working When Run VBA

GeoKoro13 · 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!!!