Find if a given value is in a cell, if so then try next value until unique

I have the below sub that checks on a separate worksheet if the created number in textbox8 already exists, at the moment there is a message box that alerts the user that the part number already exists, they have to click OK, then the number is incremented by 1, the process is repeated until a unique number is found. This is the written to the worksheet along with some other data.

What I need to do is remove the message box so it will automatically search and find the next available number.

I added the following code to the sub, but this has no effect:

Application.DisplayAlerts = False
  MsgBox "This already exists"
  SendKeys "{ENTER}"
Application.DisplayAlerts = True

code

'Create part number and check
Private Sub CommandButton2_Click()


With TextBox26
   If myreset = True Then
      .Tag = 0
      myreset = False
   End If
  .Tag = Val(.Tag) + 1
  .Text = "-" & VBA.Format(Val(.Tag), "0000")
End With


Dim iNum(1 To 8) As String
iNum(1) = TextBox24.Value
iNum(2) = TextBox25.Value
iNum(3) = TextBox26.Value


TextBox8.Value = iNum(1) + iNum(2) + iNum(3)

'check article exists

Dim emptyRow As Long
Dim rcnt As Long
Dim i As Long



ActiveWorkbook.Sheets("existing").Activate

rcnt = Sheets("existing").Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To rcnt

If TextBox8.Text = Sheets("existing").Range("A" & i).Value Then
Application.DisplayAlerts = False
  MsgBox "This already exists"
  SendKeys "{ENTER}"
 Application.DisplayAlerts = True

 Exit Sub
 End If
Next

Range("A1").Select
Do
If IsEmpty(ActiveCell) = False Then
  ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = TextBox8.Text