Excel VBA unique ID generator - excel

Question

I am trying to generate unique IDs for topics of discussion. The data will be like so:
Status ID Topic Commentary
Open FIL-1 FILM
Open FIL-2 FILM
Closed LAN-1 LANG.
Open LAN-2 LANG.
The idea is that when on a new row regardless of whether it was added above or below of the last unique ID I use VBA to find the next ID. So for example above if I were to add another row at the top with the topic LANG. then it would find that LAN-2 is the lastest ID and +1 to it to become LAN-3.
I got this working when the topics were all the same with the code below (topics were all "FIL" but now there are multiple topics):
Private Function getNextID() As String
Dim row As Integer
Dim currentID As Integer
currentID = 0
' Loop round rows
For row = MIN_ROW To MAX_ROW
' Only use rows which are not blank
If Worksheets(DISCUSS).cells(row, ID).Value <> "" Then
If Mid$(Worksheets(DISCUSS).cells(row, ID).Value, InStr(3, Worksheets(DISCUSS).cells(row, ID).Value, "-") + 1) > currentID Then
currentID = Mid$(Worksheets(DISCUSS).cells(row, ID).Value, InStr(3, Worksheets(DISCUSS).cells(row, ID).Value, "-") + 1)
End If
End If
Next row
getNextID = "FIL" & "-" & currentID + 1
End Function
Does anyone know how I can set an array with the topic abbreviations used in the ID and use the code i've already written to loop through the same process using the abbreviations in the array to get the next ID for the specific topic being added?

Answer 1

I adjusted the code you had to include an array like you needed, it does mean you will have to pass into your procedure the name of the topic you are requesting an ID for, this could be automated if needed but its hard to know what the bigger picture is for you project so I have left it as this: -
Private Function getNextID(ByVal StrTopic As String) As String
Static AryTopics(2, 1) As String
Dim row As Integer
Dim currentID As Integer
Dim LngCounter As Long
currentID = 0
'By having the array declared static and being a fixed size, it will only get built once
'then rememebered
If AryTopics(0, 0) = "" Then
AryTopics(0, 0) = "FILM"
AryTopics(0, 1) = "FIL"
AryTopics(1, 0) = "LANG."
AryTopics(1, 1) = "LAN"
AryTopics(2, 0) = "GEOG."
AryTopics(2, 1) = "GEO"
End If
'The topic must be passed into the proce to know what to get the ID for
'This gets the related topic code from the array
For LngCounter = 0 To UBound(AryTopics, 1)
If AryTopics(LngCounter, 0) = Trim(UCase(StrTopic)) Then
StrTopic = AryTopics(LngCounter, 1)
Exit For
End If
Next
' Loop round rows
For row = MIN_ROW To MAX_ROW
' Only use rows which are not blank
If Worksheets(DISCUSS).Cells(row, ID).Value <> "" Then
'This checks to see if the ID starts with the related topic code we care about, if it does then we keep checking
If Left(Trim(UCase(Worksheets(DISCUSS).Cells(row, ID).Value)), Len(StrTopic) + 1) = StrTopic & "-" Then
If Mid$(Worksheets(DISCUSS).Cells(row, ID).Value, InStr(3, Worksheets(DISCUSS).Cells(row, ID).Value, "-") + 1) > currentID Then
currentID = Mid$(Worksheets(DISCUSS).Cells(row, ID).Value, InStr(3, Worksheets(DISCUSS).Cells(row, ID).Value, "-") + 1)
End If
End If
End If
Next row
'Output include the topic code
getNextRiskID = StrTopic & "-" & currentID + 1
End Function

Answer 2

This code does the trick, except the first entry for some reason (the Evaluate Formula button shows it's working, but right at the end it replaces the value with 0).
So, manually add the first ID then run the code from row 3 to the last row of your list (you'll also need to add code to ignore empty rows).
Public Sub Test()
Dim x As Long
For x = 3 To 7
AddID ThisWorkbook.Worksheets("Sheet1").Cells(x, 2)
Next x
End Sub
Public Sub AddID(Target As Range)
'Formula using A1 style:
'=LEFT($C7,3) & "-" & COUNTIF($B$2:INDEX($B:$B,ROW()-1),LEFT($C7,3) & "*")+1
'Relative column (ID is 1 column left of Topic).
Target.FormulaR1C1 = "=LEFT(RC[1],3) & ""-"" & COUNTIF(R2C:INDEX(C,ROW()-1), LEFT(RC[1],3) & ""*"")+1"
'Absolute column (ID is column B, Topic is column C)
'Target.FormulaR1C1 = "=LEFT(RC3,3) & ""-"" & COUNTIF(R2C2:INDEX(C2,ROW()-1), LEFT(RC3,3) & ""*"")+1"
Target = Target.Value
End Sub