MS Excel crashing while running VBA

Question

I have a macro that takes information from Yahoo's finance website, based on the name of the company, and puts it into Excel. When I run through it using F8, the macro and Excel run fine. However, when I try to run through it using F5 (with no breaks), it will not get beyond the 5th iteration (there are 5.5k iterations to be done).

The laptop I'm running is a Dell XPS with an i-7 2670QM chip @ 2.2GHz, 8GB RAM, and a 64-bit OS (Win 7). The MS excel is 2013.

The code is as follows:

Sub Yahoo_Company_List()

Application.ScreenUpdating = False

On Error GoTo ErrorHandler

a = 3

'While Worksheets("Storage Sheet").Cells(a, 1) <> vbNullString
While a < 10

    Worksheets("Downloads").Activate
    Columns.Select
    Selection.ClearContents

    Symbol = Worksheets("Storage Sheet").Cells(a, 1)

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://uk.finance.yahoo.com/q/is?s=" & Symbol & "&annual", Destination:=Range( _
        "$A$1"))
        .Name = "is?s=" & Symbol & "&annual"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "9"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://finance.yahoo.com/q/bs?s=" & Symbol & "+Balance+Sheet&annual", Destination _
        :=Range("$A$41"))
        .Name = "bs?s=" & Symbol & "+Balance+Sheet&annual"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "9"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    Range("A91").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://finance.yahoo.com/q/cf?s=" & Symbol & "+Cash+Flow&annual", Destination:= _
        Range("$A$91"))
        .Name = "cf?s=" & Symbol & "+Cash+Flow&annual"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "9"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://uk.finance.yahoo.com/q?s=" & Symbol & "&ql=1", Destination:=Range("$A$122"))
        .Name = "q?s=" & Symbol & "&ql=1_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """table1"",""table2"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    Call Reformatting_m.reformatting

    Worksheets("Calculations").Activate

    Range("B:F").Select
    Selection.ClearContents

    i = 1

    While i < 109
        m = 1
        If Cells(i, 1) <> vbNullString Then
            While m <= 3
                DataValue = WorksheetFunction.VLookup(Cells(i, 1), Worksheets("Downloads").Range("A1:F200"), 1 + m, False)
                If Not IsError(DataValue) Then
                    Cells(i, 1 + m) = DataValue
                End If

                If Cells(i, 1) = "Period Ending" Then
                    Cells(i, 1 + m).NumberFormat = "m/d/yyyy"
                Else
                    Cells(i, 1 + m).NumberFormat = 0
                End If
                m = m + 1
            Wend
        End If
        i = i + 1
    Wend

    Call FScore_m.FScoreCalc

'    Application.Calculate

    Worksheets("Storage Sheet").Activate

    n = 5
    k = 8
    p = 2


    While n < 67
        If ((p = 9 Or p = 10 Or p = 11 Or p = 12 Or p = 13 Or p = 27) And k = 10) Or k = 11 Or _
            ((p = 21 Or p = 22 Or p = 23 Or p = 24 Or p = 25 Or p = 26) And k = 9) Then
            k = 8
            p = p + 1
        ElseIf k < 11 Then
            Cells(a, n) = Worksheets("Calculations").Cells(p, k)
            k = k + 1
            n = n + 1
        End If
    Wend

    a = a + 1

Wend

Application.ScreenUpdating = True

ErrorHandler:
Application.ScreenUpdating = True
Exit Sub

End Sub

Any suggestions on how to get it to work the macro to work?

Best I can say it to set breaks in the code to see which point makes excel crash, its not giving you an error for not enough memory so it but be a line of code that is upsetting excel, after you find the line of code that is giving you the problem either you will be able to fix this or we can help further — Mr.Burns
– Mr.Burns, Commented May 20, 2016 at 14:17
The query could be failing for certain value of Symbol = Worksheets("Storage Sheet").Cells(a, 1), maybe the 6th value. The code failed on executing it with incorrect/empty value of Symbol — CS.
– CS., Commented May 20, 2016 at 14:33

Gary Evans · Accepted Answer · 2016-05-20 14:54:13Z

I can't give you a full answer as we don't have access to the code in the Call procedures (e.g. Reformatting_m.reformatting) and they may be causing the issue but I had a similar thing on some extensive Word automation in which it was almost like it was running out of memory and would crash 'randomly'.

The best advice I would highly recommend is creating variables and working in them. For example: -

Option Explicit

Sub Yahoo_Company_List()
Dim a               As Long
Dim Wkbk            As Excel.Workbook
Dim WkSht_Downloads As Excel.Worksheet

Application.ScreenUpdating = False

On Error GoTo ErrorHandler

Set WkBk = ThisWorkbook
    Set WkSht_Downloads = WkBk.Worksheets("Downloads")

        While a < 10
            WkSht_Downloads.Columns.ClearContents
        End While

    Set WkSht_Downloads = Nothing
Set WkBk = Nothing

Working like that causes less connections to the workbook meaning resources will be free and a crash may not occur.

Collectives™ on Stack Overflow

MS Excel crashing while running VBA

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related