Find highest value and populate newly inserted rows with a unique ID

Sorry, but I知 new to VBA and have been looking at other posts to get me this far, see code below, now I知 getting out of my depth and help!

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知 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壇 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. Option for both of these scenarios would be good.

Here's where I've got to:

Sub testmess()

Dim myRng As Range
Dim CurSel As Range
Dim myCell As Range
Dim MaxValue As Double

Set CurSel = Selection
For Each myCell In Intersect(Columns(1), ActiveSheet.UsedRange).Cells
If Intersect(myCell, CurSel) Is Nothing Then
If myRng Is Nothing Then
Set myRng = myCell
Else
Set myRng = Union(myCell, myRng)
End If
End If
Next myCell

If myRng Is Nothing Then
'can't do max!
MaxValue = 0
MsgBox MaxValue & vbLf & "no cells looked at"
Else
MaxValue = Application.Max(myRng)
MsgBox MaxValue & vbLf & myRng.Address(0, 0)
End If


'find last used cell and move down to blank cell below

  Range("A4").End(xlDown).Select
  ActiveCell.Offset(1, 0).Select
  ActiveCell.Value = MaxValue + 1



End Sub

Ok, I have had a rethink and come up with much simpler approach, which sort of works. If cells B3 and/or B4 have no values in them, it seems to go a bit wrong. I have a bit of a work round for this, but it's not that neat. You can see this work round in the second piece of code, below.

Any advise on making it better would be good?

Also, the original code works well if you want to ignore an active cell in the column that you want to find maxvalue for, but same glitch on empty cells in the header row, not an issue if these are never empty, but this scenario cropped up in testing. Otherwise, a handy piece of code if that's what you want. Although, moving the active cell at the end would be a good idea, if you want to run it several times, if you don't do that it ignores the cell that has just been populated.

Sub ProjectNo()

Dim rng As Range
Dim MaxValue As Double
 
Set rng = Range("b1", Range("b65536").End(xlUp))
 
MaxValue = Application.WorksheetFunction.Max(rng)
MsgBox MaxValue & vbLf & "Last Project No Used"

'find last used cell and move down to blank cell below

  Range("B3").End(xlDown).Select
  ActiveCell.Offset(1, 0).Select
  ActiveCell.Value = MaxValue + 1



End Sub

Also, I would quite like to run this along side my macro to insert new rows into my spreadsheet, I have tried to simply add it to the bottom of that macro , but it doesn't seem to work when I do that? Here's my insert new row code: Row 3 is a header row, Row 4 is the row that I want to copy and insert, keeping formula and format. It works fine, but now I cant work out how to make both pieces of code work together.

There is some fiddling about to delete data/formula in cells that I don't want to copy from row 4, and then putting it back in at the end. So, you will see that if I run the insert rows macro to insert say 3 rows, I then need to run the Project No Macro 3 times to insert the project numbers into those rows. Ideally, Id like to do all of that in one macro.

Sub Insertnewrows()

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False


Range("A4").Select
    Selection.ClearContents
Range("U4").Select
    Selection.ClearContents
Range("B4").Select
    Selection.ClearContents
     

Dim n As Integer, rng As Range

n = InputBox("How many new rows do you want?")
Set rng = Range("a4")
rng.Select
line2:
Range(rng.Offset(1, 0), rng.Offset(n, 0)).EntireRow.Insert
Range(rng, rng.EntireRow).Copy
Range(rng, rng.Offset(n, 0)).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False


 Range("A4").Select
    ActiveCell.FormulaR1C1 = _
        "Example /Test Entry (Please do not delete or modify this)"
    With ActiveCell.Characters(Start:=1, Length:=57).Font
        .Name = "Comic Sans MS"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        
        Range("U4").Select
    ActiveCell.FormulaR1C1 = _
        "10000"
        
   Range("B4").Select
    ActiveCell.FormulaR1C1 = _
        "?"
    
    ActiveWindow.ScrollColumn = 2

        
    End With
    Range("A5").Select



MsgBox " Please do not modify or delete the first row!"



End Sub