Troubleshooting - Prevent Duplicate Entries From VBA Code

I have some VBA code that I had some help building to generate a random 5-character code with the format: letter-number-letter-number-letter (e.g. d6s8b). The code seems to be working just fine but there should be 1.7 million options and we've created roughly 6,000 codes and we have already come across 8 duplicate codes that were generated. I thought the code would be preventing that, so I'm not sure why this is happening. Anyone's help would be greatly appreciated!

Our code is below:

Sub GenerateUniqueRandomValue()

  Dim ws As Worksheet

  Dim r As Range
  Dim iLastRow As Long
  Dim x1 As Long
  Dim x2 As Long
  Dim x3 As Long
  Dim x4 As Long
  Dim x5 As Long
  Dim bNeedMore As Boolean
  Dim sValue As String
  
  'ASCII Table Reference: http://www.asciitable.com/
  

  'Create the Worksheet object
  Set ws = ThisWorkbook.Sheets("Master Code Generator")

  
  'Use the System Timer to Generate the first Random Number
  Call Randomize
  
  'Loop until there is a unique Value
  bNeedMore = True
  While bNeedMore = True
  
  
    'Generate a random number between 0 and 25
    'Create the numerical equivalent of an ASCII character between 'a' and 'z'
    x1 = Int(26 * Rnd()) + Asc("a")

    'Generate a random number between 0 and 9
    x2 = Int(10 * Rnd())

    'Generate a random number between 0 and 25
    'Create the numerical equivalent of an ASCII character between 'a' and 'z'
    x3 = Int(26 * Rnd()) + Asc("a")

    'Generate a random number between 0 and 9
    x4 = Int(10 * Rnd())

    'Generate a random number between 0 and 25
    'Create the numerical equivalent of an ASCII character between 'a' and 'z'
    x5 = Int(26 * Rnd()) + Asc("a")

    'Create the entire string
    sValue = Chr(x1) & x2 & Chr(x3) & x4 & Chr(x5)
    Debug.Print sValue
  
  
    'Make sure the value is unique in Column 'A'
    'Find the first occurence of the string in Column 'A'
    Set r = Nothing
    Set r = ws.Columns("A").Find(What:=sValue, _
                        After:=ws.Range("A1"), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False, _
                        SearchFormat:=False)
                      
                      
    'Exit if the value is unique
    'Otherwise try again
    If r Is Nothing Then
      bNeedMore = False
    End If
 
  Wend
 
 'Find the last item in Column 'B' (must be row 1 or more)
 'Runtime error is generated if the column is Empty
 On Error Resume Next
 iLastRow = ws.Range("B:B").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 If iLastRow < 1 Then
   iLastRow = 1
 End If
 On Error GoTo 0
 
 'Put the value in Column 'B' in the next row
 ws.Cells(iLastRow + 1, "B").Value = sValue
 
 
 'Clear object pointers
 Set r = Nothing
 Set ws = Nothing
  
End Sub