I've got one for a VBA guru: how to generate a string of alphanumeric characters based on a cell input for length where the first character can be over-written (cell input) and there are constraints on characters. The code below works great but I'm not thinking clearly right now and am struggling to come up with the best way to add limits on characters (one example: 4 numbers, two upper case letters, and two lower case letters). Any suggestions?
VBA Code:
Sub RandomAlphanumeric()
Const strCharacters As String = "23456789ABCDEFGHJKMNPQRSTUVWXYZabcdefghjkmnpqrstuvwxyz"
Dim cllAlphaNums As Collection
Dim arrUnqAlphaNums(1 To 20000) As String
Dim varElement As Variant
Dim strAlphaNum As String
Dim AlphaNumIndex As Long
Dim lUbound As Long
Dim lNumChars As Long
Dim i As Long
Dim shape As Excel.shape
Set cllAlphaNums = New Collection
lUbound = UBound(arrUnqAlphaNums)
lNumChars = Len(strCharacters)
On Error Resume Next
Do
strAlphaNum = vbNullString
For i = 1 To Sheets("Sheet1").Range("c7").Value
strAlphaNum = strAlphaNum & Mid(strCharacters, Int(Rnd() * lNumChars) + 1, 1)
Next i
cllAlphaNums.Add strAlphaNum, strAlphaNum
Loop While cllAlphaNums.Count < lUbound
On Error GoTo 0
For Each varElement In cllAlphaNums
AlphaNumIndex = AlphaNumIndex + 1
arrUnqAlphaNums(AlphaNumIndex) = varElement
Next varElement
Range("A1").Resize(lUbound).Value = Application.Transpose(arrUnqAlphaNums)
Set cllAlphaNums = Nothing
' Erase arrUnqAlphaNums
If Not (IsEmpty(Worksheets("sheet1").Range("C8").Value)) Then
For i = 1 To AlphaNumIndex
Cells(i, 1).Value = WorksheetFunction.Replace(Cells(i, 1).Value, 1, 1, Worksheets("sheet1").Range("C8").Value)
Next i
End If
Worksheets("sheet1").Range("C:Z").Clear
For Each shape In ActiveSheet.Shapes
shape.Delete
Next
ActiveWorkbook.SaveAs Filename:=Worksheets("sheet1").Range("C12").Value & "Random_Alphanumeric.csv", _
FileFormat:=xlCSV, CreateBackup:=False
End Sub