svendiamond
Well-known Member
- Joined
- Jun 13, 2014
- Messages
- 1,504
- Office Version
- 365
- Platform
- Windows
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.
Rich (BB code):
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