Always increment to the next largest number in a series - even after sorting

[lorikgator]

This answer may exist and I just don't know the right combo of Google search terms to find it because I've tried everything!

I have a "to do" list and I want to add a unique index number for each new entry BUT I'm going to be sorting the list for due dates and priorities. How can I automatically always increment to the largest number when I enter a new row? I know ROW() would get me the largest number, but then I'd have to also copy-> paste value every time. If that's the best/easiest way, so be it, but I figure there must be another option...

Excel 2007, Windows 7

Example:

Index	Task	Priority	Due Date	Status
1003	Manager report	1 - High	10/1/2014	2 - In progress
1001	Create presentation	1 - High	10/5/2014	1 - Not started
1004	Time sheet	2 - Medium	9/30/2014	2 - In progress
1002	Worksheet update	2 - Medium	9/25/2014	3 - On hold
1005	Check e-mail	3 - Low	9/10/2014	2 - In progress
(1006)	(new row)

<tbody>
</tbody>

I want to use a formula or maybe even a macro to always give the next highest number in the existing sequence, even though they're not sorted in their column.

Any ideas welcome!

Lorikgator

 

[RickXL]

Hi,

If you are happy to use row numbers then you could try this macro.

You need to click on the tab of the sheet you are using. Select "View Code" from the menu then paste in the following code and save it:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        If Target.Cells.Count = 1 And _
            IsEmpty(Target.Value) And _
            Not IsEmpty(Target.Offset(-1, 0).Value) Then
            Range("A" & Target.Row) = Target.Row
            Cancel = True
        End If
    End If

End Sub

When you go back to the worksheet, if you right-click in a single, empty, cell in column A that has an occupied cell above it then the macro will insert the current line number into the cell you have right-clicked.
Setting Cancel to True stops the usual right-click menu from being displayed.

This is a variation that looks at the biggest number used so far, it adds one and uses that as the next number.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    Dim NextNum As Long
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        If Target.Cells.Count = 1 And _
            IsEmpty(Target.Value) And _
            Not IsEmpty(Target.Offset(-1, 0).Value) Then
            NextNum = Application.WorksheetFunction.Max(Range("A1:A" & Target.Row)) + 1
            Range("A" & Target.Row) = NextNum
            Cancel = True
        End If
    End If

End Sub

With both macros, every time you right-click a cell the macro will run. The If statements will check to see if all the conditions are met to add a new index number. If not, then they will return and the usual right-click menu will be displayed.

Thinks: I might add this to my Excel ToDo List!

 

[lorikgator]

Beautiful! I think I may try the second one. I should have posted that I have a workable solution, but I was hoping to see some other ideas so I waited. What I'm doing now is just entering my to do list items without a code - however many I need (and my list is formatted as a table so it just adds it to the table) then I run this macro when I'm done to add the numbers to any empty cells (newly-added items)

Sub RenumberSort()
'
' Macro to sort the Ref # column and add the next available Ref # in the series to any new rows with blank Ref # cells
'
' Perform the sort to order the Ref # field from high to low
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("ToDo[Ref '#]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range(Range("A3"), Range("A3").SpecialCells(xlLastCell))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' Add the next numbers in the range to the new rows with blank Ref # cells
    Dim rg As Range
    Set rg = Range("B3").End(xlDown).Offset(0, -1)
    If rg = "" Then
     Set rg = Range(rg, rg.End(xlUp))
     If rg.Row >= 3 Then rg.Cells(1, 1).AutoFill rg
    End If
    
' Re-sort back to priority-based ordering
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("ToDo[Category]"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("ToDo[Due Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("ToDo[Priority]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("ToDo[Status]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("ToDo[Category]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("ToDo[Ref '#]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range(Range("A3"), Range("A3").SpecialCells(xlLastCell))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

I'm still a super VBA newb so I'm sure it could be better! I never could have done it without this and the other excellent Excel help boards, though!