Quantcast
Channel: Active questions tagged crash - Stack Overflow
Viewing all articles
Browse latest Browse all 7187

Excel Keeps Crashing When Running VBA Code

$
0
0

I have made a spreadsheet which copies a heap of data from, many closed excel files in a specified folder. It runs fine on my computer at work but at home it starts to work then crashes a few cycles in. I am unsure of what the issue could be. This is the code

Sub runallmacros()
CommandButton1_Click
delrowsifzero
End Sub
Sub CommandButton1_Click()
Dim x, fldr As FileDialog, SelFold As String, i As Long
Dim ws As Worksheet, ws1 As Worksheet
Dim Wb As Workbook, Filename As String

'User Selects desired Folder
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    If .Show <> -1 Then GoTo Cleanup
    SelFold = .SelectedItems(1)
End With

'All .xls* files in Selected FolderPath including Sub folders are put into an array
x = Split(CreateObject("wscript.shell").exec("cmd /c Dir """& SelFold & "\*.xls"" /s/b").stdout.readall, vbCrLf)

 Set ws1 = ThisWorkbook.Sheets("sheet2")

'Loop through that array
For i = LBound(x) To UBound(x) - 1

'Open (in background) the Workbook
    With GetObject(x(i))

        ThisWorkbook.Sheets(1).UsedRange
        Filename = Split(x(i), "\")(UBound(Split(x(i), "\")))
   Set Wb = Workbooks(Filename)
    Set ws = Nothing
    On Error Resume Next
    'change sheet name here
    Set ws = Wb.Sheets("Builder Costings")
    On Error GoTo 0
           If Not ws Is Nothing Then
ws.Range("A1:C13").Copy
ws1.Range("A1:C13").Offset(lngrow).PasteSpecial xlPasteFormats
ws1.Range("A1:C13").Offset(lngrow).PasteSpecial xlPasteValues
ws.Range("H1:i2").Copy
ws1.Range("E1:f2").Offset(lngrow).PasteSpecial xlPasteFormats
ws1.Range("E1:f2").Offset(lngrow).PasteSpecial xlPasteValues
ws.Range("H3:h4").Copy
ws1.Range("d1:d2").Offset(lngrow).PasteSpecial xlPasteFormats
ws1.Range("d1:d2").Offset(lngrow).PasteSpecial xlPasteValues
ws.Range("A15:E279").Copy
ws1.Range("A14:E278").Offset(lngrow).PasteSpecial xlPasteFormats
ws1.Range("A14:E278").Offset(lngrow).PasteSpecial xlPasteValues
    lngrow = lngrow + 279
    ActiveSheet.Range("A1").Copy
    End If
    Wb.Close False
                 End With
Next i

Cleanup:
Set fldr = Nothing
End Sub


Sub delrowsifzero()
Application.ScreenUpdating = False
Dim LastRow As Long
 Worksheets("sheet2").Activate
 On Error Resume Next
   LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim x As Long
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("A:a"& LastRow) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
    .SetRange Range("A:a"& LastRow)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
For x = LastRow To 2 Step -1
    If Cells(x, 2) = "" Or Cells(x, 2) = 0 Then
        Rows(x).EntireRow.Delete
    End If
Next x
Application.ScreenUpdating = True
  End Sub

Can someone please help me work out what is going on. I can't seem to figure it out.

the crash dump is as follows

Description Faulting Application Path: C:\Program Files\Microsoft Office\root\Office16\EXCEL.EXE

Problem signature Problem Event Name: APPCRASH Application Name: EXCEL.EXE Application Version: 16.0.12130.20344 Application Timestamp: 5dc608a2 Fault Module Name: VBE7.DLL Fault Module Version: 0.0.0.0 Fault Module Timestamp: 5d07efc9 Exception Code: c0000005 Exception Offset: 00000000000021b9 OS Version: 10.0.18362.2.0.0.768.101 Locale ID: 3081

Extra information about the problem Bucket ID: 077f50cf87ab5caca46705a64aab5c30 (1470150015135210544)


Viewing all articles
Browse latest Browse all 7187

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>