Unique Number generate with date in text box form

[ajkua]

Hi,

I am trying this code in my excel but i am getting error.

What i want to do i have 4 option button AFBB , HOMES , WOVEN ,HARDGOODS and i would like to select starting 4 Character of buttons and generate Unique ID with date but i am unable to this
can you please help me?

Private Sub CommandButton1_Click()
Dim Rng As Range, Dn As Range, n As Long
Dim pType As String
Dim oMax As Long
Dim datee As Date
datee = Format(Date, "dd-mm-yyyy")
Set Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
Const StartNum = 10000
For n = 1 To 4
With Me.Controls("OptionButton" & n).Object
    If .Value = True Then
        pType = Left(.Caption, 3)
        Exit For
    End If
End With
Next
If pType = vbNullString Then MsgBox "Please Select Option Button": Exit Sub


With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Right(Dn.Value, 1) = pType Then
    If Not .Exists(Dn.Value) Then
       .Add Dn.Value, Mid(Dn, 2)
     
    oMax = Application.Max(.Item(Dn.Value), Mid(Dn, 2))
    Else
        MsgBox "Number Exists:-" & Dn.Value
    End If
End If
Next
If .Count = 0 Then
    Range("B" & Rng.Count + 1) = pType & StartNum & datee
Else
    Range("B" & Rng.Count + 1) = pType & oMax + Rng & datee
End If
End With
End Sub

 

[Fluff]

Can you please explain exactly what you are trying to do?

 

[ajkua]

Can you please explain exactly what you are trying to do?

Hi,

I am trying to insert data in B cell from userform i have four option button AFBB , HOMES, HARDGOODS, WOVEN.
when i select anyone of above option button from userform then generate unique number every time with the help of option buttons+Current Date below is example.

Suppose i am select AFBB option button from GUI from

Then unique number generate should be AFB/any integer uniquenumber / current date

like this AFB/12054/3-04-2019

I hope this will help for you.

Thanks
Ajay

 

[Fluff]

How about

Private Sub CommandButton1_Click()
   Dim Cl As Range
   Dim pType As String, UniqueRef As String
   Dim MidNum As Long, n As Long
   Dim datee As String
   
   datee = Format(Date, "dd-mm-yyyy")
   For n = 1 To 4
      With Me.Controls("OptionButton" & n).Object
         If .Value = True Then
            pType = Left(.Caption, 3)
            Exit For
         End If
      End With
   Next
   
   If pType = vbNullString Then MsgBox "Please Select Option Button": Exit Sub
   MidNum = Int((99999 - 10000 + 1) * Rnd() + 10000)
   UniqueRef = pType & "/" & 14081 & "/" & datee
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      Do Until .Exists(UniqueRef) = False
         MidNum = Int((99999 - 10000 + 1) * Rnd() + 10000)
         UniqueRef = pType & "/" & MidNum & "/" & datee
      Loop
   End With
   Range("B" & Rows.Count).End(xlUp).Offset(1).Value = UniqueRef
End Sub