Find Highest Value And Populate Newly Inserted Rows With Unique ID?

I want to find the highest value in a column (MaxValue) and populate first blank cell in a column with Maxvalue+1. Basically, I want to provide each new row with a unique project number. First, I'm running a macro to insert rows which copies the formula and format from Row 4, the user enters how many rows he wants and the requested number of new rows are inserted below Row 4 (That bit all works fine) . I now want to find the highest project number that has been used in Column 1, starting at Row 4, increment the highest project number by 1 and populate the newly inserted rows with the new project number.

I have a couple of problems with code I'm trying to use: If the active cell in column 1 is highest value the code ignores the active cell, i.e. this works once, as the cell that I have just populated becomes the active cell and the highest number, i.e. the next time the macro runs I get the same number as the active cell.

Ideally, I'd like use the number of rows that the user requested in the macro to insert new rows to be used in this macro to provide a unique project number for each of the newly inserted rows. (The add new rows macros uses Dim NoToAdd As Integer, as the number of rows that the user wishes to insert). Although, I'm quite happy to run the macro several times to find and populate projects which have not been allocated project numbers.

Here's where I've got to:

[Code] .....