Table Field Auto numbering

[Stidd]

Hi All,

Please help!

I have a database in an excel table and need a formula or macro that auto-numbers new rows with a unique key like Access would. I have seen loads of formulas using ROW() and OFFSET(). However, I want the values to stay static despite sorting the table by different fields, or deleting rows.

Any help appreciated.

Regards,

Si

 

[TomPC]

I have a database in an excel table and need a formula or macro that auto-numbers new rows with a unique key like Access would. I have seen loads of formulas using ROW() and OFFSET(). However, I want the values to stay static despite sorting the table by different fields, or deleting rows.

Hi Si

I see your problem. A formula will not work so easily because of sorting.

There are two approaches I can think of:

(1) You could have a button you click to hardcode/autonumber new rows.
(2) You could use an event so that if you alter a cell on a row (for the first time), it autonumbers the row.

(1) would be easiest to code but would involve you periodically clicking the button in order to get the numbering going.

(2) might give you a few headaches: if you accidentally typed something somewhere, it would automatically number the row.

Let me know which way you'd like to go and I'll see if I can help.

 

[Stidd]

You're a star thanks TomPC.

I'm not sure as I think either (1) or (2) would suffice. Ideally I like to know how to do both to see how obtrusive (1) is but appreciate you may not have the time to explain both.

Given (2) is the easiest for the user, I think that is the best option if only one is available.

Yours,
Si

 

[TomPC]

Hi Si

Sorry about the delay getting back to you. It involved plumbers - let's just leave it at that!

Here's a bit of code I use for detecting when someone changes a particular cell on a sheet. The code needs to be placed not in a module, but in the sheet's own code area ie Sheet 1 (Name). These appear below the modules in the code window.

Private Sub Worksheet_Change(ByVal ChangedCell As Range)
    If ChangedCell.Address = Sheets("Macros").[NamedCell].Address Then
        Call Initialise
    End If
End Sub

So the code is an 'event' rather than a normal Sub. It executes when something happens (Worksheet... Change) rather than being called.

So 'ChangedCell' is a cell that just been changed. I compare it with a particular named range (a cell) that I am monitoring called "NamedCell".

Some things that might help you:

You can say:

x=ChangedCell.Column
x=ChangedCell.Row
x=ChangedCell.Address
x=ChangedCell.Count etc.
​

So your code might be:

Private Sub Worksheet_Change(ByVal ChangedCell As Range)
    With Cells(ChangedCell.Row,1)
       If .Value = "" Then
            .Value = Application.WorksheetFunction.Max(Columns(1))+1
       End If
    End With
End Sub

This is basically saying:

When you change a row, if there is no value in column A, make the value in column A on that row be the maximum number that already exists in Column A + 1.

That will work (I didn't test the code - might be the odd typo), but your users will need to be disciplined (and users never are).



A few more if statements might help you:

1. If the cell above the one we're about to write to is blank then don't update with a number (obviously don't check this if Row 1 or you'll error). This stops new IDs being assigned to accidental clicks not in the general body of data.
2. If the column of the cell clicked (ChangedCell.Column) is greater than than the number of columns you have in use, ignore. This stops IDs being assigned to things which are definitely not your data.
3. If UserName="President Sarkozy of France" then Msgbox("You are not authorised to use this database as punishment for being rude to the Prime Minister of Great Britain and Northern Ireland.")

But I'll leave you to play with those!

Hope that's the sort of thing you're after. Have a good one - Happy Christmas.

Tom

 

[Stidd]

Thanks Tom, plenty for me to play with!

I'm not going to get a chance to look at this probably until Jan as I'm off skiing this evening. But I'll let you know how I get on when I get back - Thanks for your help mate.

Have a great Christmas too!

 

[TomPC]

Take me skiing with you and I'll write your code.

The EUR and The SNOW have both dropped just in time for you (assuming altitudinous French Alps).