Improve speed of Sort!

Hi, I just learned to do the copy and paste the fast way and my macros are thanking me for it.

Is their a way to improve the speed of a Sort?

                                                'sort Analyzer 5 lines
                                                Range("A2:G6").Select
                                                ActiveWorkbook.Worksheets("Analyzer").Sort.SortFields.Clear
                                                ActiveWorkbook.Worksheets("Analyzer").Sort.SortFields.Add Key:=Range("A2"), _
                                                SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                                                With ActiveWorkbook.Worksheets("Analyzer").Sort
                                                .SetRange Range("A2:G6")
                                                .Header = xlNo
                                                .MatchCase = False
                                                .Orientation = xlTopToBottom
                                                .SortMethod = xlPinYin
                                                .Apply
                                                End With

This Sort is done thousands of times in a loop so any speed change is noticeable!


Any help is appreciated! Thanks.

Yes, using the Range.Sort method is faster than the Worksheets.sort method. But why are you sorting thousands of times in a loop? Wouldn't it be easier to just sort once after everything else is done?

Oh, I'm checking multiple combinations of lines in a list with some of them being constant. All lines have to be put in order of slope for the condition formulae to work.

Here's my macro I'm trying to speed up.

Can you see anything else I can change to make it faster?

Sub Test()
Application.ScreenUpdating = False
Dim x As Integer
x = 0

For a = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    For B = a + 1 To Cells(Rows.Count, 1).End(xlUp).Row
        
                      If a <> B Then
                        
                        Application.Calculation = xlCalculationManual
                        With Sheets("Intersect")
                        .Range(.Cells(2, 1), .Cells(2, 7)).Value2 = Range(Cells(a, 1), Cells(a, 7)).Value2
                        .Range(.Cells(3, 1), .Cells(3, 7)).Value2 = Range(Cells(B, 1), Cells(B, 7)).Value2
                        End With
                        Application.Calculation = xlCalculationAutomatic
                    
                            If Sheets("Intersect").Range("I5") < Sheets("Intersect").Range("I6") Then
                            
                                x = x + 1
                                
                                Sheets("Analyzer").Range("a7:g8").Value = Sheets("Intersect").Range("A2:G3").Value
                                
                                Application.ScreenUpdating = True
                                Sheets("Data").Range("m10") = x
                                Sheets("Data").Range("n10").Value = Sheets("Intersect").Range("i5").Value
                                Application.ScreenUpdating = False
                                
                                For d = 2 To Cells(Rows.Count, 1).End(xlUp).Row
                                        
                                    For e = d + 1 To Cells(Rows.Count, 1).End(xlUp).Row
                                    
                                        For f = e + 1 To Cells(Rows.Count, 1).End(xlUp).Row
            
                                            If d <> e And d <> f And e <> f Then
                                                
                                                Application.Calculation = xlCalculationManual
                                                With Sheets("Analyzer")
                                                .Range(.Cells(2, 1), .Cells(2, 7)).Value2 = Range(Cells(d, 1), Cells(d, 7)).Value2
                                                .Range(.Cells(3, 1), .Cells(3, 7)).Value2 = Range(Cells(e, 1), Cells(e, 7)).Value2
                                                .Range(.Cells(4, 1), .Cells(4, 7)).Value2 = Range(Cells(f, 1), Cells(f, 7)).Value2
                                                .Range("a5:g6").Value = Sheets("Analyzer").Range("A7:G8").Value
                                                End With
                                                Application.Calculation = xlCalculationAutomatic
                
                                                'Sheets("Analyzer").Range("a5:g6").Value = Sheets("Analyzer").Range("A7:G8").Value
                                                
                                                'sort Analyzer 5 lines
                                                
                                                Range("A2:G6").sort key1:=Range("A1"), Order1:=xlDescending, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
                                                
                                                'Header:=xlGuess, OrderCustom:=1, MatchCase:=False,
                                                
                                                If WorksheetFunction.CountIf(Sheets("Analyzer").Range("M2:M6"), "YES") = 5 Then
                                                
                                                    'copy X outer & Y outer for comparison
                                                    
                                                    Sheets("Intersect").Range("i17:j21").Value = Sheets("Analyzer").Range("i2:J6").Value
                                                    
                                                    'copy X outer & Y outer for comparison
                                                    
                                                    Sheets("Intersect").Range("c9:g13").Value = Sheets("Analyzer").Range("a2:e6").Value
                                                    
                                                    'copy Intersect 3 lines for star point comparison
                                                    
                                                    Sheets("Intersect").Range("A23").Value = Sheets("Intersect").Range("A2:J5").Value
                                                    
                                                    
                                                    If WorksheetFunction.CountIf(Sheets("Intersect").Range("k23:k25"), "True") > 0.1 Then 
                                                        If WorksheetFunction.CountIf(Sheets("Intersect").Range("k2:k3"), "Yes") = 2 Then  
                                                            If WorksheetFunction.CountIf(Sheets("Intersect").Range("H17:H21"), "True") > 0.1 Then 
                                                            
                                                                'copy star to results page for charting
                                                                Sheets("Analyzer").Select
                                                                Range("A2:M6").Select
                                                                Selection.copy
                                                                Sheets("Results").Select
                                                                Range("A2").Select
                                                                Selection.Insert Shift:=xlDown
                                                            
                                                                Sheets("Results").Range("n7:r488").Value = Sheets("Results").Range("i2:M481").Value
                                                            
                                                                Sheets("Data").Select
                                                                ActiveSheet.ChartObjects("Chart 11").Activate
                                                                Application.ScreenUpdating = True
                                                                Beep
                                                                Application.ScreenUpdating = False
                                                            
                                                            End If
                                                        End If
                                                    End If
                                                End If
                                            End If
                            
                                            Sheets("Data").Select
                                            DoEvents
                                        Next f
                                    Next e
                                Next d
                            
                            End If
                        
                        Sheets("Data").Select
                        
                        DoEvents
                    End If
    Next B
Next a
End Sub

You can get rid of the select statements. I also see you have application.calculation and application.screenupdating being updated during the loops instead of outside of the loops. You could set the sheets equal to variables instead of having the code define the sheet each time. But without knowing what your start looks like and what your desired end looks like, there's not much more advice I can offer. I also can't figure out why you need so many for loops. It seems incredibly inefficient.