Forum Discussion

Greg Bonaparte's avatar
Greg Bonaparte
Iron Contributor
May 19, 2019

Why so slow and periodic "not responding" in Excel 2016?

This macro works perfectly but runs quite slow and periodically the screen goes white, says excel unresponsive, but then continues on to completion without trouble. Someone mention before that I should remove code from area where the macro "paste values" but the "paste from" cells are different sizes than the "paste to" cells and the code they suggested did not work. Here is the code. Please let me know if you have suggestions:

 

Sub GreaterThan4k()
'
' GreaterThan4k Macro
'
Range("R2").Select
Selection.Copy
Range("S2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.EnableEvents = False

Range("R2,T2:T27,U2:U11,V2:W5,U30:U629").Select
Range("U30").Activate
Application.CutCopyMode = False
Selection.ClearContents

Application.EnableEvents = True

Application.EnableEvents = True
Range("B30:AX629").Select
Range("AX629").Activate
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"R30:R629"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("B30:AX629")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
Range("S2").Select
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2").Select
Application.CutCopyMode = False
Selection.Copy
Range("T2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q10").Select
Application.CutCopyMode = False
Selection.Copy
Range("T3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AT30:AT37").Select
Range("AT37").Activate
Application.CutCopyMode = False
Selection.Copy
Range("T4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q19").Select
Application.CutCopyMode = False
Selection.Copy
Range("U2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P10").Select
Application.CutCopyMode = False
Selection.Copy
Range("U3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U2").Select
Application.CutCopyMode = False
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AS30:AS31").Select
Range("AS31").Activate
Application.CutCopyMode = False
Selection.Copy
Range("U4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P19").Select
Application.CutCopyMode = False
Selection.Copy
Range("V2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P10").Select
Application.CutCopyMode = False
Selection.Copy
Range("V3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("V2").Select
Application.CutCopyMode = False
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AS30:AS31").Select
Range("AS31").Activate
Application.CutCopyMode = False
Selection.Copy
Range("V4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2").Select
MsgBox "There may be SUGGESTED SHARES to utilize unallocated funds. Add ADDITIONAL SHARES now."

End Sub

excel
Macros and VBA

1 Reply

  • JKPieterse's avatar
    JKPieterse
    Silver Contributor
    May 20, 2019

    Greg Bonaparte A macro works more efficient without all the selecting and activating. Also, transferring values directly, rather than through a copy and paste is faster.

    I have tried my best to convert all cell addresses properly, but this does need a thorough check against your own macro:

    Sub GreaterThan4k()
'
' GreaterThan4k Macro
'
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Range("S2").Value = Range("R2").Value

    Range("R2,T2:T27,U2:U11,V2:W5,U30:U629").ClearContents

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
                                                                  "R30:R629"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                                                             xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B30:AX629")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    '
    
    Range("R2").Value = Range("S2").Value
    Range("T2").Value = Range("R2").Value
    Range("T3").Value = Range("Q10").Value
    Range("T4:T11").Value = Range("AT30:AT37").Value
    Range("U2").Value = Range("Q19").Value
    Range("U3").Value = Range("P10").Value
    Range("R2").Value = Range("U2").Value
    Range("U4:U5").Value = Range("AS30:AS31").Value
    Range("V2").Value = Range("P19").Value
    Range("V3").Value = Range("P10").Value
    Range("R2").Value = Range("V2").Value
    Range("V4:V5").Value = Range("AS30:AS31").Value
    Range("R2").Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "There may be SUGGESTED SHARES to utilize unallocated funds. Add ADDITIONAL SHARES now."
End Sub

Resources