CODEWITHSUNDEEP
excelvba
Nuttapong Phunsub
Nuttapong Phunsub

Reputation: 25

Running a particular macro freezes Microsoft Excel

I am currently using the following macro within Microsoft Excel. However anytime I run it, the application freezes up for quite a while. Not quite sure where the problem may be in my code below:

Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer

    Cells.Select
    Selection.RowHeight = 20.25

Columns("E:E").Insert
Columns("E:E").ColumnWidth = 7
Columns("J:J").Insert
Columns("J:J").ColumnWidth = 7
Columns("L:L").Insert
Columns("L:L").ColumnWidth = 7
Columns("M:M").Insert
Columns("M:M").ColumnWidth = 7
Columns("M:M").Insert
Columns("M:M").ColumnWidth = 7
Columns("L:L").Copy
Range("J1").PasteSpecial xlPasteFormats
Application.CutCopyMode = flase

    For Each cel In Range("F:F")
        If cel.Font.Underline = xlUnderlineStyleSingle Then
            cel.Value = "x" & cel.Value
        End If
    Next
    For Each cel In Range("H:H")
        If cel.Font.Underline = xlUnderlineStyleSingle Then
            cel.Value = "x" & cel.Value
        End If
    Next




Application.ScreenUpdating = False

a = Cells(Rows.Count, "C").End(xlUp).Row





For b = 1 To a
If IsNumeric(Cells(b, "C").Value) Then
st = Cells(b, "G").Value


t1 = Cells(b, "F")
t2 = Cells(b, "H")

v1 = 1.72
v2 = 2.1
v3 = 1.9
v4 = 1.8
v5 = 2

If InStr(st, "+10") > 0 And Left(Cells(b, "F"), 1) = "x" Then
Cells(b, "E") = v1
Cells(b, "J") = v2

ElseIf InStr(st, "-10") > 0 And Left(Cells(b, "F"), 1) = "x" Then
Cells(b, "E") = v3
Cells(b, "J") = v3

ElseIf InStr(st, "-5") > 0 And Left(Cells(b, "F"), 1) = "x" Then
Cells(b, "E") = v5
Cells(b, "J") = v4

ElseIf Left(Cells(b, "F"), 1) = "x" Then
Cells(b, "E") = v4
Cells(b, "J") = v5

ElseIf InStr(st, "+10") > 0 And Left(Cells(b, "H"), 1) = "x" Then
Cells(b, "J") = v1
Cells(b, "E") = v2

ElseIf InStr(st, "-10") > 0 And Left(Cells(b, "H"), 1) = "x" Then
Cells(b, "J") = v3
Cells(b, "E") = v3

ElseIf InStr(st, "-5") > 0 And Left(Cells(b, "H"), 1) = "x" Then
Cells(b, "J") = v5
Cells(b, "E") = v4

ElseIf Left(Cells(b, "H"), 1) = "x" Then
Cells(b, "J") = v4
Cells(b, "E") = v5


ElseIf InStr(st, "-10") > 0 Then
Cells(b, "J") = v3
Cells(b, "E") = v3

Else
Cells(b, "E") = 0
Cells(b, "J") = 0

End If







End If
Next


Application.ScreenUpdating = True

End Sub

I believe the issue may be with RAM or the following snippet of code below, I have tired to modify it but have not had any luck:

 For Each cel In Range("F:F")
            If cel.Font.Underline = xlUnderlineStyleSingle Then
                cel.Value = "x" & cel.Value
            End If
        Next
        For Each cel In Range("H:H")
            If cel.Font.Underline = xlUnderlineStyleSingle Then
                cel.Value = "x" & cel.Value
            End If
        Next

Upvotes: 0

Views: 46

Answers (1)

Grade 'Eh' Bacon
Grade 'Eh' Bacon

Reputation: 3833

Yes, you've nailed the problem on the head with the 2 For loops in the beginning of the macro - you are cycling through ~2 Million cells to check their values. Instead, you should limit your search to only the areas which have values in them. You have already done this further below, with this line:

a = Cells(Rows.Count, "C").End(xlUp).Row

So you should change your For loops similarly - if you like you can define a variable as you have done for A, and check to see what the lowest cell # is that has a value in column F then H - but I will show another way:

For Each cel In Intersect(Sheets(1).Range("F:F"), Sheets(1).UsedRange)
    If cel.Font.Underline = xlUnderlineStyleSingle Then
        cel.Value = "x" & cel.Value
    End If
Next

For Each cel In Intersect(Sheets(1).Range("H:H"), Sheets(1).UsedRange)
    If cel.Font.Underline = xlUnderlineStyleSingle Then
        cel.Value = "x" & cel.Value
    End If
Next

Note that you may need to change the reference to Sheets(1) above depending on what index number your sheet is in.

Upvotes: 2

Related Questions