Excel closes all workbooks if certain part of macro is executed???

[svendiamond]

Hello! I have been successfully running a code for a while now but I just added an extra few lines which does a little bit extra copying and pasting some numbers... for some reason if this part of the code is executed, all my open workbooks are closed! I have Googled this problem and found various answers, to no avail. Do you see anything weird here? The highlighted part is the part that causes the crash (if the user answers "Yes" to the msgbox). And actually, this sub routine is activated through a different sub routine... in which I just have the line "filterthing" to activate this sub, then continue. Also, if I step-through the code, it works just fine. It's only when I run the whole thing that it crashes.

Sub filterThing()


Dim lRow As Long, fRow As Long, loadNumber As Long, cube As Long, saveLoad As VbMsgBoxResult, zRow As Long, xRow As Long
    With Sheets("SUMMARY")
            .Range("J2:K50").ClearContents
            .Range("J2:K50").Borders.LineStyle = xlNone
        lRow = .Range("F" & Rows.Count).End(xlUp).Row
            .Range("F1:F" & lRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Columns("J:J"), Unique:=True
        fRow = .Range("J" & Rows.Count).End(xlUp).Row
            .Range("K2").Value = "=COUNTIF(F:F,J2)/(COUNTA(F:F)-1)"
            .Range("K2:K" & fRow).Select
                Selection.FillDown
            .Range("J2:K" & fRow).Borders.LineStyle = xlContinuous
                
                'sort
                .Range("K2").Select
                ActiveWorkbook.Worksheets("SUMMARY").Sort.SortFields.Clear
                ActiveWorkbook.Worksheets("SUMMARY").Sort.SortFields.Add Key:=Range("K2"), _
                    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                        With ActiveWorkbook.Worksheets("SUMMARY").Sort
                            .SetRange Range("J1:K" & fRow)
                            .Header = xlGuess
                            .MatchCase = False
                            .Orientation = xlTopToBottom
                            .SortMethod = xlPinYin
                            .Apply
                        End With
    End With
    
saveLoad = MsgBox("Save this load?", vbYesNo)
    If saveLoad = vbYes Then
        loadNumber = InputBox("Load number?")
        cube = InputBox("Cube?")
        zRow = Sheets("TRENDS").Range("C" & Rows.Count).End(xlUp).Row + 1
            Sheets("SUMMARY").Range("J2:K" & fRow).Copy
                With Sheets("TRENDS")
                    .Activate
                    .Range("C" & zRow).PasteSpecial xlPasteValues
                    .Range("A" & zRow).Value = loadNumber
                    .Range("B" & zRow).Value = cube
                         xRow = .Range("C" & Rows.Count).End(xlUp).Row
                                .Range("A" & zRow & ":B" & xRow).Select
                                    Selection.FillDown
                                .Range("A" & zRow & ":D" & xRow).Borders.LineStyle = xlContinuous
                    .Range("A1").Select
                End With
    End If
End Sub

 

[dmt32]

Hi,
no thoughts on why your code should crash in such dramatic fashion but see if this updated code makes any difference.

Sub filterThing()
    Dim saveload As Integer, i As Integer
    Dim xRow As Long, zRow As Long
    Dim lRow As Long, fRow As Long
    Dim Prompt As Variant, GetInput(2) As Variant
    
    
    With Sheets("SUMMARY")
            .Range("J2:K50").ClearContents
            .Range("J2:K50").Borders.LineStyle = xlNone
        lRow = .Range("F" & Rows.Count).End(xlUp).Row
            .Range("F1:F" & lRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Columns("J:J"), Unique:=True
        fRow = .Range("J" & Rows.Count).End(xlUp).Row
            .Range("K2").Value = "=COUNTIF(F:F,J2)/(COUNTA(F:F)-1)"
            .Range("K2:K" & fRow).FillDown
            .Range("J2:K" & fRow).Borders.LineStyle = xlContinuous
                
                'sort
                .Sort.SortFields.Clear
                .Sort.SortFields.Add Key:=Range("K2"), _
                    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                        With ActiveWorkbook.Worksheets("SUMMARY").Sort
                            .SetRange Range("J1:K" & fRow)
                            .Header = xlGuess
                            .MatchCase = False
                            .Orientation = xlTopToBottom
                            .SortMethod = xlPinYin
                            .Apply
                        End With
    End With
    
    
    saveload = MsgBox("Save this load?", 36, "Save Load")
    
    If saveload = vbYes Then
    Prompt = Array("Load Number", "Cube")
    i = LBound(Prompt)
    
    Do
        GetInput(i) = InputBox("Enter " & Prompt(i), Prompt(i))
        'cancel pressed
        If StrPtr(GetInput(i)) = 0 Then Exit Sub
        'numeric only
        If IsNumeric(GetInput(i)) Then i = i + 1
    Loop Until i > UBound(Prompt)
        
            Sheets("SUMMARY").Range("J2:K" & fRow).Copy
            
                With Sheets("TRENDS")
                zRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1
                    .Range("C" & zRow).PasteSpecial xlPasteValues
                    .Range("A" & zRow).Value = CLng(GetInput(LBound(Prompt)))
                    .Range("B" & zRow).Value = CLng(GetInput(UBound(Prompt)))
             xRow = .Range("C" & Rows.Count).End(xlUp).Row
                    .Range("A" & zRow & ":B" & xRow).FillDown
                    .Range("A" & zRow & ":D" & xRow).Borders.LineStyle = xlContinuous
                End With
    End If
End Sub

Dave