CODEWITHSUNDEEP
vbaexcel
SammMmm
SammMmm

Reputation: 3

Automatically Sort Rows in Excel by Date

I'm currently trying to self-teach myself VBA code in Excel, but I've run into a problem.

What I'm wanting Excel to do is to automatically order specific rows according to the date entered in specific cells. For example, dates will be entered into cells E36-E40 only, and as they are entered rows 36-40 (not including column A) will automatically sort themselves according to the oldest date first.

I've done a macro recording of this and it has spat out this code:

Sub AutoSort()

Range("B36:H40").Select
ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Add Key:=Range( _
    "E37:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("SHEET NAME").Sort
    .SetRange Range("B36:H40")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub

I've tried to make this automatic as shown below, however does not work!

Sub Worksheet_Change1(ByVal Target As Range)
If Intersect(Target, Range("E36, E37, E38, E39, E40")) Is Nothing Then
Exit Sub
Else
Sub AutoSort()

Range("B36:H40").Select
ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Add Key:=Range( _
    "E37:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("SHEET NAME").Sort
    .SetRange Range("B36:H40")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End If
End Sub
End Sub

Any help would be greatly appreciated!

Upvotes: 0

Views: 3356

Answers (3)

user3598756
user3598756

Reputation: 29421

using Sort() method of Range leads to a more concise code:

Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    On Error GoTo ErrHandler
    If Not Intersect(Target, Range("E36:E40")) Is Nothing Then _
        Range("B36:H40").Sort key1:=Range("E36"), order1:=xlAscending, Header:=xlNo, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, MatchCase:=False, Orientation:=xlTopToBottom

ErrHandler:
    Application.EnableEvents = True
End Sub

or, encapsulating the sorting operation into a specific sub:

Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E36:E40")) Is Nothing Then AutoSort Range("B36:H40"), Range("E36")
End Sub


Sub AutoSort(dataRng As Range, orderCol As Range)
    Application.EnableEvents = False
    On Error GoTo ErrHandler
    dataRng.Sort key1:=orderCol, order1:=xlAscending, Header:=xlNo, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, MatchCase:=False, Orientation:=xlTopToBottom

ErrHandler:
    Application.EnableEvents = True
End Sub

Upvotes: 0

user6432984
user6432984

Reputation:

MSDN definition of Me: Provides a way to refer to the specific instance of a class or structure in which the code is currently executing.

I used Me instead of ActiveWorkbook.Worksheets("SHEET NAME") because this code is only relevant to the worksheet that calls the event. I originally used ActiveSheet but if a Macro changed the values from a different worksheet than that worksheet would be active and it would be sorted.

  • Turn off EnableEvents, whenever changing values on the ActiveSheet from the Worksheet_Change event. This will prevent the Worksheet_Change event from triggering itself causing an infinite loop and crashing Excel.
  • Include an Error Handler that will turn the events back on, if an error is thrown.
  • The key range started at row 37
  • .Header = xlYes should be .Header = xlNo
Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    On Error GoTo ResumeEvents
    If Not Intersect(Target, Range("E36:E40")) Is Nothing Then
        With Me
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("E36:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Range("B36:H40")
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With

    End If
ResumeEvents:
    Application.EnableEvents = True
End Sub

Upvotes: 1

bzimor
bzimor

Reputation: 1628

Don't encapsulate your Subprocedure AutoSort() in your other procedure. Put your AutoSort() procedure in module, then call it within worksheet code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E36, E37, E38, E39, E40")) Is Nothing Then
   Exit Sub
Else
   AutoSort
End If
End Sub

Also, change .Header = xlYes to .Header = xlNo if Row 36 doesn't contain header.

Upvotes: 0

Related Questions