Sub Macro1() Dim lLastRow As Long, lLoop As Long lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'turn off updates to speed up code execution With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual .DisplayAlerts = False End With For lLoop = 1 To lLastRow Rows(lLoop).Sort key1:=Cells(lLoop, 1), order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal, DataOption2 _ :=xlSortNormal Next With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic .DisplayAlerts = True End With End Sub