Generowanie nowej liczby dopóki nie spełni wymogu.

Witam,
Borykam się z pewnym problemem i nie za bardzo umiem go rozgryźć
Problem mam następujący :
W textBox po wpisaniu nr PESEL następuje generowanie NR_ID.
NR_ID składa się z 8 cyfry, pierwsze 4 to generowane automatycznie z zakresu od 1000 do 5000 a ostatnie 4 to ostatnie cyfry nr pesel.
To wszystko działa ładnie, ale potrzebuje aby po wygenerowaniu tego NR_ID automatycznie został sprawdzony czy nie występuję drugi taki sam i jeżeli występuje to niech genereuje jeszcze raz dopóki nie wygeneruje unikalnego NR_ID.
Próbowałem coś sam wymyślić ale mi nie idzie.
Byłbym bardzo wdzięczny za naprowadzenie mnie na rozwiązanie.
Dzięki
Pozdrawiam.

A może takie coś - dzielisz NR_ID na 2 części (jak pisałeś, po 4 znaki). Powiedzmy, że 4 ostatnie cyfry numeru pesel to 2137. Sprawdzasz sobie swoje dane szukajac maksimum z pierwszego kwartetu NR_ID, który kończy się na 2137 (jeżeli nie ma jeszcze NR_ID z taką końcówką, to przypisujesz NR_ID 10002137). Jak znajdziesz już tego maxa, to dodajesz 1 i masz unikalne NR_ID.

Pokaż kod, bo tak to jedynie możemy napisać sposób postępowania (tak, jak to zrobił powyżej @flinst-one), ale ciężko jest dać bardziej konkretne porady albo zaproponować jakąś zmianę w kodzie - żeby działał zgodnie z Twoimi oczekiwaniami.

Może sprawdź:

• How can I generate GUIDs in Excel?
• vba How can I generate GUID

Przykład generowania ID za pomocą Scriptlet.TypeLib skrypt w VBScript (vbs)

Dim sGUIDList

For iIndex = 1 To 10
  sGUIDList = sGUIDList & String(5, " ") & iIndex & ". " & GetGUID(10) & vbCrLf
Next

MsgBox sGUIDList, vbOKOnly + vbInformation, "Lista unikalnych ID"


Function GetGUID(iSetGUIDLength)
  Dim sGUID, iGUIDLength

  sGUID = Mid(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
  sGUID = Replace(sGUID, "-", "")

  iGUIDLength = Len(sGUID)
  If iSetGUIDLength > iGUIDLength Then iSetGUIDLength = iGUIDLength
  if iSetGUIDLength < 6 Then iSetGUIDLength = 6

  GetGUID = Mid(sGUID, iGUIDLength - (iSetGUIDLength - 1), iGUIDLength) 
End Function

Na razie w kodzie mam takie coś :

Private Sub TB_Pesel_Change()
Dim tb_DaneTSW As ListObject
 Set tb_DaneTSW = Worksheets("DANE_TSW").ListObjects("TBL_DaneTSW")
Dim i As Integer
If Len(TB_Pesel.value) = 11 Then
If IsTableEmpty("DANE_TSW", "TBL_DaneTSW") = False Then
 For i = 1 To tb_DaneTSW.DataBodyRange.Rows.Count
   If TB_Pesel.Text = tb_DaneTSW.DataBodyRange(i, tb_DaneTSW.ListColumns("PESEL").Index).value Then
    MsgBox "Wpisany nr PESEL znajduje się już w BAZIE DANYCH", vbCritical, "Popraw PESEL"
    TB_Pesel.BackColor = xlRed
    BTN_OK.Enabled = False
    Exit For
   Else
    TB_Pesel.BackColor = xlWhite
    BTN_OK.Enabled = True
    Label16.Caption = GenerujID(TB_Pesel.Text)
    Nr_ID = Label16.Caption
    LBL_NRID.Caption = Nr_ID
    TextBox1.value = Nr_ID
   End If
 Next i
End If
End If
End Sub

Ten kod sprawdza czy wpisany pesel jest już w bazie danych i jeżeli nie to generuje ID
Teraz po wygenerowaniu po Buttonem (na razie w celach rozgryzienia problemu) zacząłem robić takie coś

Private Sub CommandButton1_Click()
Dim tb_DaneTSW As ListObject
 Set tb_DaneTSW = Worksheets("DANE_TSW").ListObjects("TBL_DaneTSW")
 Dim Y As Double
 Dim i As Integer
 Dim IsID As Boolean
Y = TextBox1.value
Do
  For i = 1 To tb_DaneTSW.DataBodyRange.Rows.Count
  If tb_DaneTSW.DataBodyRange(i, 2).value = Y Then
   IsID = True
   MsgBox "IsID = TRUE"
  Else
  IsID = False
  MsgBox "IsID = False"
  End If
  Next i
Loop Until IsID = False
 
End Sub

Za chiny nie potrafię zrobić tak żeby podczas sprawdzania czy jest ID już w bazie żeby samo się wywołało czyli.

1. sprawdź czy jest ID
2. Jeżeli nie ma to wyjdź z pętli
3. Jeżeli jest to wygeneruj nowy ID i sprawdź jeszcze raz ( generuj i sprawdzaj dopóki ID będzie unikalny)
   Pomyślałem też że może zrzucić to na użytkownika czyli tak jak podczas sprawdzenia nr PESEL zrobić dodatkowy TextBox z nr ID i jak znajdzie ID w bazie to textbox na czerwono, pokazać przyciski i niech go użytkownik wygeneruje jeszcze raz.

1. PIerwszy pomysł. Najprościej (ale nie najlepiej) to dodaj kolejny arkusz i ukryj go.
   Ja dodałem arkusz o nazwie NRID i wpisałem z ręki pierwszy wolny numer - zakładam że tę wartość znajdziesz (to musisz uzupełnić przed pierwszym użyciem)
   Jak już uzupełnisz raz, to później procedura (poniżej) przy uruchomieniu za każdym razem bedzie ten numer zwiększała

Public Sub daj4znakidoID()
a = Worksheets("NRID").Range("A1").Value 'stąd biorę pierwszy wolny numer
MsgBox (a) 'ja wyświetlam wartość ale Ty możesz 4 znaki z ID połączyć z 4 znakami z PESEL linia do usunięcia

Worksheets("NRID").Range("A1").Value = a + 1 ' dodaję kolejny ID któy będzie wolny do następnego użycia
MsgBox (Worksheets("NRID").Range("A1").Value) ' tutaj sobie sprawzam czy numer się powiększył przy wywołaniu procedury. linia do usunięcia

End Sub

2.Drugi pomysł. W arkuszu, który masz "Dane_TSW" po prostu dodaj kolumnę z tym numerem ID, uzupełnij dla wszytkich rekordów, które tam są. Jeśli będzie posortowana to śmiało możesz wyszukiwać ostatnią wartość i do niej dodać 1, moja procedura powyzej po lekkiej modyfikacji to zrobi.

Tylko moje propozycje nie sprawdzą się w sytuacji jeśli usuwasz rekordy, czyli ID po jakimś czasie się "zwolni". W takim przypadku będziesz miał dziury w numeracji

Przy projektowaniu tego id nie wziąłeś pod uwagę ryzyka kolizji?

Pewnie overkill ale możesz zastosować sobie filtr bloma jeżeli zależy Ci na czasie chociaż ja osobiście w tym przypadku raczej poszedłbym w minimalizowanie ryzyka kolizji (choć to pewnie zalezy od skali)