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

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