Generate random alphanumeric code via VBA Form

[lejoyeux3]

I am starting a new thread to better track my post.

Hereis what I want to achieve:

1- I have a dashboard with to button: One will call a form and the other onefor admin password (that one works fine).

2- I have a sheet called "Product Code List" with 3 columns in it.One for "Product Code", another one for "Product Name" anda last one for "Requested By"

3- The Form works as follow:

We have 2 Text boxes (One for Product Name & One for the RequestorID) then a button to generate the unique random alphanumeric Product Code.Once generated, all values should be added to thesheet.
- All fields are mandatory when using the form and for a given"Product Code" should correspond to a "Product Name" and a"Requestor ID".
- Product Code should be unique, Product Name should be unique.
- The code in the form, before adding the values in sheet"Product Code List" should make a look up and see if Product Codeor Name already exist in the database
- If it does not exist then add the 3 values in the form to in theDatabase "Product Code List"

So basically, the code you received is meant to perform that task.

But I am not able to insert the code or the excel doc.

Can you assist?

Below find the code:

Private Sub Generate_Product_Code_Click()[/FONT][/COLOR]

[COLOR=#222222][FONT="Verdana"]'Sub UniqueCodes()
Dim LengthOfCode As Long, strCodeChars As String, uniquecode As String
Dim x As Long, r As Long[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]'*************** [START] Trying to Append another on this ***************
Dim sProductCode As String
Dim sProductName As String
Dim sRequestedBy As String
'Dim lngUnitStartRow As Long, lngUnitStartColumn As Long, lngUnitLastRow As Long
'Dim lngProductNameStartRow As Long, lngProductNameStartColumn As Long, lngProductNameLastRow As Long
Dim lngLastRow As Long, i As Long[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]'All inputs are mandatory. In case of missing inputs prompt user and exit.
If Product_Name.Text = "" Then
    MsgBox "All fields are mandatory - Please enter Product Name."
    Exit Sub
End If[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]If My_ID.Text = "" Then
    MsgBox "All fields are mandatory - Please enter your  ID."
    Exit Sub
End If[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]'Determine last row with data in Product Code List database
lngLastRow = shProductCodeList.Cells(shProductCodeList.Rows.Count, "A").End(xlUp).Row[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]'Search if the Product Code generated and Product Name already exists. If it exists prompt user and exit. If it does not exist, add it to database.[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]Set rngProductCode = shProductCodeList.Range(shProductCodeList.Cells(2, 1), shProductCodeList.Cells(lngLastRow, 1)).Find(sProductCode)
If Not rngProductCode Is Nothing Then
    Product_Code.Text = sProductCode
    MsgBox "Product Code " & sProductCode & " already exists in database."
    Exit Sub[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]
Set rngProductName = shProductCodeList.Range(shProductCodeList.Cells(2, 2), shProductCodeList.Cells(lngLastRow, 1)).Find(sProductName)
If Not rngProductName Is Nothing Then
    Product_Name.Text = sProductName
    MsgBox "Product Name " & sProductName & " already exists in database."
    Exit Sub[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]Else
    Product_Code.Text = sProductCode
    shProductCodeList.Cells(lngLastRow + 1, 1) = sProductCode
    shProductCodeList.Cells(lngLastRow + 1, 2) = Product_Name.Text
    shProductCodeList.Cells(lngLastRow + 1, 3) = _ID.Text
    
    
End If[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]'***************
LengthOfCode = 12
strCodeChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
With CreateObject("scripting.dictionary")[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]For r = 2 To r
    Do
            For x = 1 To LengthOfCode
                uniquecode = uniquecode & Mid(strCodeChars, Application.RandBetween(1, 36), 1)
            Next
            If Not (.exists(uniquecode)) Then .Add uniquecode, 1: Cells(r, 3) = uniquecode: uniquecode = "":
                        
            Exit Do
            
    Loop
    [/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]Next
End With
    [/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]'***************[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]If lngLastRow > 1 Then
    'Format Product Code List Table.
    shProductCodeList.Visible = xlSheetVisible
    shProductCodeList.Select
    shProductCodeList.Range(shProductCodeList.Cells(2, 1), shProductCodeList.Cells(lngLastRow + 1, 6)).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ThemeColor = 10
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ThemeColor = 10
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ThemeColor = 10
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ThemeColor = 10
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = -0.499984740745262
            .Weight = xlHairline
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = -0.499984740745262
            .Weight = xlHairline
        End With
        
        With Selection.Font
            .Name = "Calibri Light"
            .Size = 9
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        
    'Make alternate rows appear in different color for making it easier to read data
        For i = 2 To lngLastRow + 1
            If i Mod 2 = 1 Then
            shProductCodeList.Range(shProductCodeList.Cells(i, 1), shProductCodeList.Cells(i, 6)).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.799981688894314
                    .PatternTintAndShade = 0
                End With
            End If
        Next i
    shProductCodeList.Visible = xlSheetVeryHidden
End If[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]'*************** [END] ***************[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]
End If[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]MsgBox "Product Code " & UCase(sProductCode) & " successfully added to database."[/FONT][/COLOR]
[COLOR=#222222][FONT="Verdana"]End Sub

 

[NdNoviceHlp]

Not real sure what difficulty you're having? Insert the code or XL document?

Private Sub Generate_Product_Code_Click()
Call Uniquecodes
End Sub

is the code to use the macro from the button. If the button is on a userform, the Uniquecodes sub can be placed in the userform code or module code.
Also remove the apostrophe before the 'Sub Uniquecodes. The code itself doesn't seem right...

If Not rngProductCode Is Nothing Then
    Product_Code.Text = sProductCode
    MsgBox "Product Code " & sProductCode & " already exists in database."
    Exit Sub
End If

Note the "End If" addition. Remove the last "End If" before Msgbox. HTH. Dave

 

[lejoyeux3]

Hello,

In fact here is the full code. I don't know why it is 2 separate code:

Private Sub Generate_Product_Code_Click()'Sub UniqueCodes()
Dim LengthOfCode As Long, strCodeChars As String, uniquecode As String
Dim x As Long, r As Long
'*************** [START] Trying to Append another on this ***************
Dim sProductCode As String
Dim sProductName As String
Dim sRequestedBy As String
'Dim lngUnitStartRow As Long, lngUnitStartColumn As Long, lngUnitLastRow As Long
'Dim lngProductNameStartRow As Long, lngProductNameStartColumn As Long, lngProductNameLastRow As Long
Dim lngLastRow As Long, i As Long
'All inputs are mandatory. In case of missing inputs prompt user and exit.
If Product_Name.Text = "" Then
    MsgBox "All fields are mandatory - Please enter Product Name."
    Exit Sub
End If
If My_ID.Text = "" Then
    MsgBox "All fields are mandatory - Please enter your  ID."
    Exit Sub
End If
'Determine last row with data in Product Code List database
lngLastRow = shProductCodeList.Cells(shProductCodeList.Rows.Count, "A").End(xlUp).Row
'Search if the Product Code generated and Product Name already exists. If it exists prompt user and exit. If it does not exist, add it to database.
Set rngProductCode = shProductCodeList.Range(shProductCodeList.Cells(2, 1), shProductCodeList.Cells(lngLastRow, 1)).Find(sProductCode)
If Not rngProductCode Is Nothing Then
    Product_Code.Text = sProductCode
    MsgBox "Product Code " & sProductCode & " already exists in database."
    Exit Sub


Set rngProductName = shProductCodeList.Range(shProductCodeList.Cells(2, 2), shProductCodeList.Cells(lngLastRow, 1)).Find(sProductName)
If Not rngProductName Is Nothing Then
    Product_Name.Text = sProductName
    MsgBox "Product Name " & sProductName & " already exists in database."
    Exit Sub
Else
    Product_Code.Text = sProductCode
    shProductCodeList.Cells(lngLastRow + 1, 1) = sProductCode
    shProductCodeList.Cells(lngLastRow + 1, 2) = Product_Name.Text
    shProductCodeList.Cells(lngLastRow + 1, 3) = _ID.Text
    
    
End If
'***************
LengthOfCode = 12
strCodeChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
With CreateObject("scripting.dictionary")
For r = 2 To r
    Do
            For x = 1 To LengthOfCode
                uniquecode = uniquecode & Mid(strCodeChars, Application.RandBetween(1, 36), 1)
            Next
            If Not (.exists(uniquecode)) Then .Add uniquecode, 1: Cells(r, 3) = uniquecode: uniquecode = "":
                        
            Exit Do
            
    Loop
    
Next
End With
    
'***************
If lngLastRow > 1 Then
    'Format Product Code List Table.
    shProductCodeList.Visible = xlSheetVisible
    shProductCodeList.Select
    shProductCodeList.Range(shProductCodeList.Cells(2, 1), shProductCodeList.Cells(lngLastRow + 1, 6)).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ThemeColor = 10
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ThemeColor = 10
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ThemeColor = 10
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ThemeColor = 10
            .TintAndShade = -0.249946592608417
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = -0.499984740745262
            .Weight = xlHairline
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = -0.499984740745262
            .Weight = xlHairline
        End With
        
        With Selection.Font
            .Name = "Calibri Light"
            .Size = 9
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        
    'Make alternate rows appear in different color for making it easier to read data
        For i = 2 To lngLastRow + 1
            If i Mod 2 = 1 Then
            shProductCodeList.Range(shProductCodeList.Cells(i, 1), shProductCodeList.Cells(i, 6)).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.799981688894314
                    .PatternTintAndShade = 0
                End With
            End If
        Next i
    shProductCodeList.Visible = xlSheetVeryHidden
End If
'*************** [END] ***************


End If
MsgBox "Product Code " & UCase(sProductCode) & " successfully added to database."
End Sub

Now below is the issue:

When I run the code, it should generate the Product code in the textbox "sProductCode" in the form, then check if the product code exist in the database. If not then add it in the next empty field. That is what I am trying to achieve, but it does not do that.

I am using a userform to enter the value and generate the product code.

 

[NdNoviceHlp]

Again this doesn't seem right...

If Not rngProductCode Is Nothing Then
    Product_Code.Text = sProductCode
    MsgBox "Product Code " & sProductCode & " already exists in database."
    Exit Sub
End If

Note the "End If" addition. Remove the last "End If" before Msgbox. HTH. Dave
I assume these are textbox names...Product_Name; My_ID.Text; Product_Code ??? They should really be ID'd by eg. UserformName.Product_Name
edit: Where does it refer to the sProductCode textbox?

 

[lejoyeux3]

Again this doesn't seem right...

If Not rngProductCode Is Nothing Then
    Product_Code.Text = sProductCode
    MsgBox "Product Code " & sProductCode & " already exists in database."
    Exit Sub
End If

Note the "End If" addition. Remove the last "End If" before Msgbox. HTH. Dave
I assume these are textbox names...Product_Name; My_ID.Text; Product_Code ??? They should really be ID'd by eg. UserformName.Product_Name
edit: Where does it refer to the sProductCode textbox?

Do you have a way for me to mail you the excel? so that you can see for yourself how it is. It could be by sending you mail in private message. BTW, I removed the End If, but still does not work.

 

[Wessie]

Hi Lejoyeux

Did you ever get sorted out with this?

Wessie

 

[lejoyeux3]

Hi Lejoyeux

Did you ever get sorted out with this?

Wessie

Yes I did but I have another one that I am struggling with.

I wonder if you can allow me to send you my excel file privately so that you can assist me. Due to file content, I can only send it privately in order for you to look through it as I have some issue making it run faster.


Than you for your help

BR,

Mark​