Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim MyData As String 
    Dim OldData As Range 
    Dim NewData As Range 
    Dim Nms, r As Long 
     
     'Determine rangename containing target
    Set Nms = ActiveWorkbook.Names 
    For r = 1 To Nms.Count 
        If Not Intersect(Target, Range(Nms(r))) Is Nothing Or _ 
        Not Intersect(Target.Offset(-1), Range(Nms(r))) Is Nothing Then 
            MyData = Nms(r).Name 
            Exit For 
        End If 
    Next 
     
    Set OldData = Range(MyData) 
     'Check if target is in existing range or cell below
    If Not Intersect(Target, OldData) Is Nothing Then 
        Set NewData = OldData 'In existing range
    ElseIf Not Intersect(Target, OldData.Offset(1)) Is Nothing Then 
        Set NewData = Union(OldData, OldData.Offset(1)) 'Below existing range
    Else 
        Exit Sub 'Not in data region
    End If 
     'Sort Data
    NewData.Sort Key1:=NewData.Cells(1), Order1:=xlAscending, Header:=xlNo, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
     'Reset range name
    ActiveWorkbook.Names.Add Name:=MyData, RefersTo:="=" & ActiveSheet.Name & "!" & _ 
    Range(NewData.Cells(1), NewData.Cells(1).End(xlDown)).AddressLocal 
     'For demo purposes ****************
    Range(MyData).Interior.ColorIndex = 6 
    MsgBox "Range " & MyData 
    Range(MyData).Interior.ColorIndex = xlNone 
     '**********************************
    Set Nms = Nothing 
    Set OldData = Nothing 
    Set NewData = Nothing 
End Sub