Sequential Numbering and Unique Reference Codes

[HangMan]

I have a sheet (attached), which uses a macro (kindly coded by Kaper), to generate two different references automatically. Column A is a sequential number using a five digit numberical format, '00000' and column B is a 'Unique Reference Number' generated as follows (Kaper suggested posting this as a new topic as it will be easier to understand what I am trying to achieve, hopefully):

Note, the sheet may be sorted by any column, so the sequential numbers in column A won't always appear in order.

This is the existing code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, prev&, beginning$, rng As Range
Set rng = Intersect(Target, Columns("H:K"))
If Not rng Is Nothing Then
  If rng.Cells.Count = 1 Then
   If Len(Cells(rng.Row, "H")) * Len(Cells(rng.Row, "K")) <> 0 Then
    Application.ScreenUpdating = False
    beginning = Left(Cells(rng.Row, "H"), 1) & "1314" & UCase(Left(Cells(rng.Row, "K"), 4))
    For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
      If Left(Cells(i, "B"), 9) = beginning Then
        If Val(Right(Cells(i, "B"), 5)) > prev Then prev = Val(Right(Cells(i, "B"), 5))
      End If
    Next i
    Cells(rng.Row, "B") = beginning & Format(prev + 1, "00000")
    Cells(rng.Row, "A") = Application.WorksheetFunction.Max(Columns("A")) + 1
    Cells(rng.Row, "A").NumberFormat = "00000"
    Application.ScreenUpdating = True
   Else
    Cells(rng.Row, "B") = ""
    Cells(rng.Row, "A") = ""
   End If
  End If
End If
If Not Intersect(Target, Range("M2:M" & Cells(Rows.Count, "M").End(xlUp).Row)) Is Nothing Then
  For Each rng In Intersect(Target, Range("M2:M" & Cells(Rows.Count, "M").End(xlUp).Row))
    If rng.Value = "Live" Then
      For i = 15 To 15
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
      For i = 23 To 23
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
        For i = 25 To 36
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
        For i = 38 To 49
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
        For i = 51 To 62
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
    ElseIf rng.Value = "Dead" Then
      For i = 15 To 15
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
    For i = 23 To 23
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
    For i = 25 To 36
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
    For i = 38 To 49
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
    For i = 51 To 62
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
'    Else
'    MsgBox "Oooops! check " & rng.Address
    End If
  Next rng
End If
End Sub

The first letter of the 'Region' from column H (London, Midlands and East, North, South), followed by the financial year '1314', followed by the first four letter from the 'Type' in column K (Landlord, Customer, Committed), followed by a sequential five digit reference number (based on the previous criteria, so an example of a typical URN would be 'S1314LAND00025'.

As there are four 'regions' and three 'types', this results in twelve different possible combinations, i.e.

L1314LAND0XXXX
L1314CUST0XXXX
L1314COMM0XXXX

M1314LAND0XXXX
M1314CUST0XXXX
M1314COMM0XXXX

N1314LAND0XXXX
N1314CUST0XXXX
N1314COMM0XXXX

S1314LAND0XXXX
S1314CUST0XXXX
S1314COMM0XXXX

where '0XXXX' represents the sequential number. The five digit sequential numbers are unque to the first nine characters, so if for example the 'L1314LAND0XXXX' URNs run from 'L1314LAND00001' to 'L1314LAND00100', when a URN is generated for 'M1314CUST0XXXX', the five digit numbers will start again at 00001, resulting in 'M1314CUST00001' up to the current highest entry and so on.

This part of the code works perfectly, so if an entry is made in both columns H and K, a 'new' URN is generated in column B using the macro, together with the next sequential number in column A. The number generated in Column A, once created, needs to be fixed (i.e. it should never change), however it is possible for the URN to change because the end user may decide to change the entry in either column H and/or K, resulting in a potential change from something like 'N1314COMM00012' to 'S1314CUST00234'.

Kapers excellent code already accommodates this possible change, however if the options in columns H and/or K are changed, it currently also updates what should now be a fixed number in column A to the next sequential number (rather than leaving this number fixed).

If a number doesn't already exist in column A, but a new row is created by the user entering values in columns H and K, then the number in column A does need to be incremented by 1 to generate a new number, which will be the next sequential number available, but if a number already exists in column A, then this number must remain fixed, even if the options in columns H and K are changed resulting in a change to the URN in column B

Kaper's code all works perfectly, apart from when a code already exists in column A and the user changes the criteria in columns H and/or K. At the moment, this changes the number in coulmn A to the next sequential number rather than leaving it fixed. If you make a new entries starting at row700 you can see how the code works.

Note: This element of the code performs a different function, and needs to remain, it is the code above this where the tweak needs to take place:

If Not Intersect(Target, Range("M2:M" & Cells(Rows.Count, "M").End(xlUp).Row)) Is Nothing Then
  For Each rng In Intersect(Target, Range("M2:M" & Cells(Rows.Count, "M").End(xlUp).Row))
    If rng.Value = "Live" Then
      For i = 15 To 15
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
      For i = 23 To 23
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
        For i = 25 To 36
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
        For i = 38 To 49
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
        For i = 51 To 62
        Cells(rng.Row, i) = Sheets("Scheme Status").Cells(rng.Row, i)
      Next i
    ElseIf rng.Value = "Dead" Then
      For i = 15 To 15
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
    For i = 23 To 23
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
    For i = 25 To 36
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
    For i = 38 To 49
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
    For i = 51 To 62
        Sheets("Scheme Status").Cells(rng.Row, i) = Cells(rng.Row, i)
        Cells(rng.Row, i) = 0
      Next i
'    Else
'    MsgBox "Oooops! check " & rng.Address
    End If
  Next rng
End If

I'm hoping someone is able to tweak the code to rectify this issue as I'm unsure how to go about achieving this. I think it will likely be easier to tweak the code than it is trying to explain the problem.

Many thanks