Excel 2010 keeps crashing after more than X number of loops

Question

I have a macro (below) that is designed to run 150,000 iterations before ending. However, after I run the code for more than 1,000 iterations, Excel goes to "Not responding" mode, and then crashes. I've left it for more than 12 hours, but it does not get any better. The code has previously been used to run the first 100,000 iterations, and is needed to run up to 1,048,576 iterations, in stages of 250,000.

The crashes also bring down Outlook, IE, as well as Chrome (although I've stopped running them at the same time, but still crashes).

If I run the code via F8, or to a checkpoint via F5, the code runs fine. However, that is impractical for another 948,576 iterations.

Any suggestions on how to resolve the issue, so it doesn't crash constantly?

The system specs are: Excel 2010 i5 (3rd gen) 8 GB RAM

Code:

Dim a As Variant
Dim b As Variant
Dim c As Variant
Dim d As Variant
Dim e As Variant
Dim i As Integer
Dim j As Double
Dim strResult As Double

a = 1
b = 100001

While b <= 250000

    While a <= 12

        If a = 1 Then

            If Cells(b, 14) = "EEEE" Then
                Cells(b, a) = 1234
            ElseIf Cells(b, 14) = "ZYXW" Then
                Cells(b, a) = 2468
            ElseIf Cells(b, 14) = "AAAA" Then
                Cells(b, a) = 3579
            ElseIf Cells(b, 14) = "BBBB" Then
                Cells(b, a) = 9764
            ElseIf Cells(b, 14) = "DDDD" Then
                Cells(b, a) = 8631
            Else
                Cells(b, a) = "ZZZZ"
            End If

        ElseIf a = 2 Then

            If Cells(b, 15) = 5 Then
                Cells(b, a) = "JPY"
            ElseIf Cells(b, 15) = 4 Then
                Cells(b, a) = "GBP"
            ElseIf Cells(b, 15) = 3 Then
                Cells(b, a) = "CHF"
            ElseIf Cells(b, 15) = 2 Then
                Cells(b, a) = "USD"
            ElseIf Cells(b, 15) = 1 Then
                Cells(b, a) = "EUR"
            Else
                Cells(b, a) = "YYYY"
            End If

        ElseIf a = 3 Then

            If Cells(b, 16) = 10234 Then
                Cells(b, a) = "A27Z2"
            ElseIf Cells(b, 16) = 10420 Then
                Cells(b, a) = "B28Y"
            ElseIf Cells(b, 16) = 10432 Then
                Cells(b, a) = "C29X"
            ElseIf Cells(b, 16) = 18953 Then
                Cells(b, a) = "D30W"
            ElseIf Cells(b, 16) = 21048 Then
                Cells(b, a) = "E31V"
            ElseIf Cells(b, 16) = 36542 Then
                Cells(b, a) = "F32U"
            ElseIf Cells(b, 16) = 36954 Then
                Cells(b, a) = "G33T"
            ElseIf Cells(b, 16) = 65425 Then
                Cells(b, a) = "H34S"
            ElseIf Cells(b, 16) = 75963 Then
                Cells(b, a) = "I35R"
            ElseIf Cells(b, 16) = 84563 Then
                Cells(b, a) = "J36Q"
            Else
                Cells(b, a) = "XXXX"
            End If

        ElseIf a = 4 Then

            strResult = 1
            For i = 1 To Len(Cells(b, 18))
                Select Case Asc(Mid(Cells(b, 18), i, 1))
                    Case 65 To 90:
                        strResult = strResult + Asc(Mid(Cells(b, 18), i, 1)) - 64
                    Case Else
                        strResult = strResult + Mid(Cells(b, 18), i, 1)
                End Select
            Next

            j = WorksheetFunction.CountIfs(Range("A1:A" & b), Range("A" & b), Range("B1:B" & b), Range("B" & b))

            Cells(b, a) = Cells(b, 1) & " - " & Cells(b, 2) & strResult & " - " & j

        ElseIf a = 5 Then

            Cells(b, a) = Cells(b, 17)

        ElseIf a = 6 Then

            If Cells(b, 19) = "SB" Then
                Cells(b, a) = "Sub"
            ElseIf Cells(b, 19) = "RD" Then
                Cells(b, a) = "Red"
            Else
                Cells(b, a) = "XXXX"
            End If

        ElseIf a >= 7 Then

            Cells(b, a) = Cells(b, a + 13)

        End If

        a = a + 1

    Wend

    b = b + 1
    a = 1

Wend

    Columns("M:Q").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:V").Select
    Selection.Delete Shift:=xlToLeft

Answer 1

This just took me less than 5 seconds to populate 10 columns out of 12. It may be because most of my sheet was empty but none the less, if you switch off calculations/screenupdating, it will be faster.

The only two columns that it doesn't populate is C and D. You cannot use a formula approach for it as it exceeds the If condition requirements. You can write a small loop for those 2.

There is no need to loop from row 100001 to 250000 and from Columns 1 to 12. You can enter a formula in those cells in one go. Here is an example

Sub Sample()
    '~~> When a = 1 i.e Col A
    range("A100001:A250000").Formula = "=IF(N100001=""EEEE"",""1234"",IF(N100001=""ZYXW"",""2468"",IF(N100001=""AAAA"",""3579"",IF(N100001=""BBBB"",""9764"",IF(N100001=""DDDD"",""8631"",""ZZZZ"")))))"

    range("B100001:B250000").Formula = "=IF(O100001=""5"",""JPY"",IF(O100001=""4"",""GBP"",IF(O100001=""3"",""CHF"",IF(O100001=""2"",""USD"",IF(O100001=""1"",""EUR"",""YYYY"")))))"

    '3,4 This needs to be coded

    range("E100001:E250000").Value = range("Q100001:Q250000").Value

    range("F100001:F250000").Formula = "=IF(S100001=""SB"",""Sub"",IF(S100001=""RD"",""Red"",""XXXX""))"

    For i = 7 To 12
        range(Cells(100001, i), Cells(250000, i)).Formula = "=" & Cells(100001, i + 13).Address
    Next i
End Sub

When I ran this code, this is what I got