Auto Sorting

[cranberrysucks]

I have a table of customer names that gets updated frequently. Is there a way to auto alphabetize as I add a name to the bottom of the list? Sample table:

A1: Customer
B1: Apple, Angel
C1: Bump, Bettie
D1: Carrie, Caryn
E1: Evans, Erin

What I'd like is to add Doris, Dorothy to F1 and after hitting enter automatically place Doris, Dorothy in E1 and bump Evans, Erin to F1. Is that possible with a macro? Any help would be appreciated.

 

[GaryWMn]

Assuming you really do want to sort row 1 left to right (except for the Customer label in A1), here is some code that should do the trick for you.

Start your Visual Basic Editor (Alt+F11) and insert a module.

In that module, place the following lines of code:

Public rNextEmptyCell As Range

Sub SetNextEmptyCell()
    Set rNextEmptyCell = Cells(1, 2).End(xlToRight).Offset(0, 1).Range("A1")
    rNextEmptyCell.Select
End Sub

In the VBE Project explorer, point to the sheet with your data (I assume Sheet1), right-click and choose View Code.

Insert this code in that window:

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="DarkGreen"]'   This routine runs every time a change is made on Sheet1[/COLOR]
[COLOR="DarkGreen"]'   If a name is typed in the next empty cell, then the range[/COLOR]
[COLOR="DarkGreen"]'   of names is sorted left to right. If any other cell is[/COLOR]
[COLOR="DarkGreen"]'   changed, then nothing happens.[/COLOR]

[COLOR="DarkGreen"]'   Pre-condition:[/COLOR]
[COLOR="DarkGreen"]'   - Need to have set in a module a public range variable named rNextEmptyCell[/COLOR]
[COLOR="DarkGreen"]'   - Need to have added in that same module a subroutine named SetNextEmptyCell[/COLOR]
[COLOR="DarkGreen"]'     which sets the public variable accordingly (see code elsewhere)[/COLOR]
    
[COLOR="DarkGreen"]'   Handle the condition when this is the first change on the sheet and[/COLOR]
[COLOR="DarkGreen"]'   the public variable pointing to the next empty cell has not yet been set[/COLOR]
    If rNextEmptyCell Is Nothing Then
[COLOR="DarkGreen"]'       Set variable pointing to next empty cell (i.e., first time through)[/COLOR]
        Call SetNextEmptyCell
        
[COLOR="DarkGreen"]'       If this is the first time through and the Target cell[/COLOR]
[COLOR="DarkGreen"]'       would have been the next empty cell, then set the next[/COLOR]
[COLOR="DarkGreen"]'       empty cell range to be the Target cell[/COLOR]
        If Target.Row = rNextEmptyCell.Row And _
           rNextEmptyCell.Column - Target.Column = 1 Then _
           Set rNextEmptyCell = Target
    End If
    
[COLOR="DarkGreen"]'   Compare the Target range for the change event to the next empty cell[/COLOR]
    Dim isect As Range
    Set isect = Application.Intersect(rNextEmptyCell, Target)
    
[COLOR="DarkGreen"]'   If they are the same, run this routine; if not, skip it[/COLOR]
    If Not isect Is Nothing Then

[COLOR="DarkGreen"]'       Declare variables just so this code makes more sense[/COLOR]
        Dim rFirstDataCell As Range
        Dim rSortRange As Range
        
[COLOR="DarkGreen"]'       Point to first cell to be sorted (i.e., B1)[/COLOR]
        Set rFirstDataCell = Cells(1, 2)
        
[COLOR="DarkGreen"]'       Set range to be sorted (i.e., B1 all the way to the right)[/COLOR]
        Set rSortRange = Range(rFirstDataCell, rFirstDataCell.End(xlToRight))
        
[COLOR="DarkGreen"]'       Perform the sort, left to right[/COLOR]
        rSortRange.Sort Key1:=rFirstDataCell, Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
            DataOption1:=xlSortNormal
        
[COLOR="DarkGreen"]'       Set public range variable pointing to next empty cell[/COLOR]
        Call SetNextEmptyCell

[COLOR="DarkGreen"]'       Clean up[/COLOR]
        Set rFirstDataCell = Nothing
        Set rSortRange = Nothing
        
    End If

[COLOR="DarkGreen"]'   Clean up[/COLOR]
    Set isect = Nothing

End Sub

Play with this and see if it does what you want.

Let us know how it goes.

Gary

 

[cranberrysucks]

Wow sleep deprivation and heat really do a number on the brain! Yeah I didn't mean left to right, I meant the column. Those should be A1:A6 (including the new entry in the example), not A1:F1. Sorry, I'm an idiot!

 

[GaryWMn]

Okay, so with a few minor modifications, here is the same code for a vertical approach:

The code for the module....

Public rNextEmptyCell As Range
 
Sub SetNextEmptyCell()
    Set rNextEmptyCell = Cells([COLOR=blue]2, 1[/COLOR]).End([COLOR=blue]xlDown[/COLOR]).Offset([COLOR=blue]1, 0[/COLOR]).Range("A1")
    rNextEmptyCell.Select
End Sub

The code for the sheet....

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR=darkgreen]'   This routine runs every time a change is made on Sheet1[/COLOR]
[COLOR=darkgreen]'   If a name is typed in the next empty cell, then the range[/COLOR]
[COLOR=darkgreen]'   of names is sorted [COLOR=blue]top to bottom[/COLOR]. If any other cell is[/COLOR]
[COLOR=darkgreen]'   changed, then nothing happens.[/COLOR]
 
[COLOR=darkgreen]'   Pre-condition:[/COLOR]
[COLOR=darkgreen]'   - Need to have set in a module a public range variable named rNextEmptyCell[/COLOR]
[COLOR=darkgreen]'   - Need to have added in that same module a subroutine named SetNextEmptyCell[/COLOR]
[COLOR=darkgreen]'     which sets the public variable accordingly (see code elsewhere)[/COLOR]
 
[COLOR=darkgreen]'   Handle the condition when this is the first change on the sheet and[/COLOR]
[COLOR=darkgreen]'   the public variable pointing to the next empty cell has not yet been set[/COLOR]
    If rNextEmptyCell Is Nothing Then
[COLOR=darkgreen]'       Set variable pointing to next empty cell (i.e., first time through)[/COLOR]
        Call SetNextEmptyCell
 
[COLOR=darkgreen]'       If this is the first time through and the Target cell[/COLOR]
[COLOR=darkgreen]'       would have been the next empty cell, then set the next[/COLOR]
[COLOR=darkgreen]'       empty cell range to be the Target cell[/COLOR]
        If Target.[COLOR=blue]Column[/COLOR] = rNextEmptyCell.[COLOR=blue]Column[/COLOR] And _
           rNextEmptyCell.[COLOR=blue]Row[/COLOR] - Target.[COLOR=blue]Row[/COLOR] = 1 Then _
           Set rNextEmptyCell = Target
    End If
 
[COLOR=darkgreen]'   Compare the Target range for the change event to the next empty cell[/COLOR]
    Dim isect As Range
    Set isect = Application.Intersect(rNextEmptyCell, Target)
 
[COLOR=darkgreen]'   If they are the same, run this routine; if not, skip it[/COLOR]
    If Not isect Is Nothing Then
 
[COLOR=darkgreen]'       Declare variables just so this code makes more sense[/COLOR]
        Dim rFirstDataCell As Range
        Dim rSortRange As Range
 
[COLOR=darkgreen]'       Point to first cell to be sorted (i.e., [COLOR=blue]A2[/COLOR])[/COLOR]
        Set rFirstDataCell = Cells([COLOR=blue]2, 1[/COLOR])
 
[COLOR=darkgreen]'       Set range to be sorted (i.e., [COLOR=blue]A2[/COLOR] all the way to the [COLOR=blue]bottom[/COLOR])[/COLOR]
        Set rSortRange = Range(rFirstDataCell, rFirstDataCell.End(xl[COLOR=blue]Down[/COLOR]))
 
[COLOR=darkgreen]'       Perform the sort, [COLOR=blue]top to bottom[/COLOR][/COLOR]
        rSortRange.Sort Key1:=rFirstDataCell, Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=[COLOR=blue]xlTopToBottom[/COLOR], _
            DataOption1:=xlSortNormal
 
[COLOR=darkgreen]'       Set public range variable pointing to next empty cell[/COLOR]
        Call SetNextEmptyCell
 
[COLOR=darkgreen]'       Clean up[/COLOR]
        Set rFirstDataCell = Nothing
        Set rSortRange = Nothing
 
    End If
 
[COLOR=darkgreen]'   Clean up[/COLOR]
    Set isect = Nothing
 
End Sub

Let us know if this works.

Gary

 

[cranberrysucks]

Works fantastic thank you. I realized after I incorporated it that I could really use the feature for a number of things. That being said I setup the same code on a couple of different sheets. The only problem I have now is that if I try to make an addition to one sheet and then move to the next sheet to make another addition it gives this error:

Run-time error '1004':

Method 'Intersect' of object'_application' failed

Seems like if you hit end and add another new customer/item to the bottom of the list it works, but is there anyway around that little error?

 

[GaryWMn]

Try adding this code in each sheet you are using...

Private Sub Worksheet_Activate()
    Call SetNextEmptyCell
End Sub

Also, if you make deletions, you would need to call the Set routine again. Here's a modification to do that....

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="DarkGreen"]'   This routine runs every time a change is made on Sheet1[/COLOR]
[COLOR="DarkGreen"]'   If a name is typed in the next empty cell, then the range[/COLOR]
[COLOR="DarkGreen"]'   of names is sorted top to bottom. If any other cell is[/COLOR]
[COLOR="DarkGreen"]'   changed, then nothing happens.[/COLOR]
 
[COLOR="DarkGreen"]'   Pre-condition:[/COLOR]
[COLOR="DarkGreen"]'   - Need to have set in a module a public range variable named rNextEmptyCell[/COLOR]
[COLOR="DarkGreen"]'   - Need to have added in that same module a subroutine named SetNextEmptyCell[/COLOR]
[COLOR="DarkGreen"]'     which sets the public variable accordingly (see code elsewhere)[/COLOR]
 
[COLOR="DarkGreen"]'   Handle the condition when this is the first change on the sheet and[/COLOR]
[COLOR="DarkGreen"]'   the public variable pointing to the next empty cell has not yet been set[/COLOR]
    If rNextEmptyCell Is Nothing Then
[COLOR="DarkGreen"]'       Set variable pointing to next empty cell (i.e., first time through)[/COLOR]
        Call SetNextEmptyCell
 
[COLOR="DarkGreen"]'       If this is the first time through and the Target cell[/COLOR]
[COLOR="DarkGreen"]'       would have been the next empty cell, then set the next[/COLOR]
[COLOR="DarkGreen"]'       empty cell range to be the Target cell[/COLOR]
        If Target.Column = rNextEmptyCell.Column And _
           rNextEmptyCell.Row - Target.Row = 1 Then _
           Set rNextEmptyCell = Target
    End If
 
[COLOR="DarkGreen"]'   Handle the condition when cells have been deleted[/COLOR]
    If rNextEmptyCell.Offset(-1, 0) = "" Then _
        Call SetNextEmptyCell
 
[COLOR="DarkGreen"]'   Compare the Target range for the change event to the next empty cell[/COLOR]
    Dim isect As Range
    Set isect = Application.Intersect(rNextEmptyCell, Target)
 
[COLOR="DarkGreen"]'   If they are the same, run this routine; if not, skip it[/COLOR]
    If Not isect Is Nothing Then
 
[COLOR="DarkGreen"]'       Declare variables just so this code makes more sense[/COLOR]
        Dim rFirstDataCell As Range
        Dim rSortRange As Range
 
[COLOR="DarkGreen"]'       Point to first cell to be sorted (i.e., A2)[/COLOR]
        Set rFirstDataCell = Cells(2, 1)
 
[COLOR="DarkGreen"]'       Set range to be sorted (i.e., A2 all the way to the bottom)[/COLOR]
        Set rSortRange = Range(rFirstDataCell, rFirstDataCell.End(xlDown))
 
[COLOR="DarkGreen"]'       Perform the sort, top to bottom[/COLOR]
        rSortRange.Sort Key1:=rFirstDataCell, Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
 
[COLOR="DarkGreen"]'       Set public range variable pointing to next empty cell[/COLOR]
        Call SetNextEmptyCell
 
[COLOR="DarkGreen"]'       Clean up[/COLOR]
        Set rFirstDataCell = Nothing
        Set rSortRange = Nothing
 
    End If
 
[COLOR="DarkGreen"]'   Clean up[/COLOR]
    Set isect = Nothing
 
End Sub

 

[GaryWMn]

You'll also want to edit the subroutine in the module as follows:

Sub SetNextEmptyCell()
[COLOR="DarkGreen"]'   Check to see if there is a list (i.e., at least something in A1:A3)[/COLOR]
    If Cells(3, 1) <> "" Then
        Set rNextEmptyCell = Cells(2, 1).End(xlDown).Offset(1, 0).Range("A1")
    Else
[COLOR="DarkGreen"]'       If nothing in A3, then just set to A2[/COLOR]
        Set rNextEmptyCell = Cells(2, 1)
    End If
    rNextEmptyCell.Select
End Sub