Incorrect text box selected upon message box closure

[ipbr21054]

Afternoon,
I am use a userform which works to how i like but noticed something that i cant put my finger on to solve it.
The code in use is shown below.
This is how it works,
The text box Honda Part Number has the flashing cursor in it ready for me to type the part number.
I enter the part number & click the Check button.
If the part number is found in my database then all the text boxes are filled with the relevant info.

This is what i have noticed to be an issue.
If the part number is not found then a message box appears telling me Non Stock Part.
I then click the X to close the message box down.
I should now see the flashing cursor in the Honda Part Number text box ready for me to type again etc but the flashing cursor is actually in the My Part Number text box.

Do you see an issue as i have changed the line of code to reflect Honda Part Number but it made no difference.

Private Sub cmdClearButton_Click()Me.MyPartNumber.Text = ""
Me.HondaPartNumber.Text = ""
Me.NumbersOnCase.Text = ""
Me.NumbersOnPcb.Text = ""
Me.Buttons.Text = ""
Me.GoldSwitchesOnPcb.Text = ""
Me.ItemType.Text = ""
Me.Notes.Text = ""
Me.Notes.BackColor = RGB(180, 180, 180) ' grey
Me.Upgrade.Text = ""
Me.Upgrade.BackColor = RGB(180, 180, 180) ' grey
Me.MyPrice.Text = ""
Me.MyPartNumber.SetFocus
End Sub


Private Sub cmdCloseButton_Click()
'close the form (itself)
Unload Me
End Sub


Private Sub cmdCheckButton_Click()
If Len(Me.MyPartNumber.Value) = 11 Then Me.MyPartNumber.Value = Format(Me.MyPartNumber, "@@@@@-@@@-@@@")
MyPartNumber.Value = UCase(MyPartNumber.Value)
HondaPartNumber.SetFocus
End Sub


Private Sub DrSite_Click()
ActiveWorkbook.FollowHyperlink Address:="http://www.theremotedoctor.co.uk/index.html", NewWindow:=True


End Sub


Private Sub EnglishNumbers_Click()
Eng.Show
End Sub


Private Sub HondaPartNumber_Change()
If (Me.HondaPartNumber.Value) = "" Then
   Me.ImageBox.Picture = LoadPicture(ThisWorkbook.Path & "\dr-logo.jpg")
Else
  ImageBox.Picture = LoadPicture(ThisWorkbook.Path & "\" & HondaPartNumber.Value & ".jpg")
  MyPartNumber.SetFocus
End If
End Sub


Private Sub LingsModel_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.lingshondaparts.com/honda_car_parts_select_model_C10", NewWindow:=True
End Sub


Private Sub LingsReg_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.lingshondaparts.com/honda_car_parts_select_REG_c23", NewWindow:=True
End Sub


Private Sub LingsVin_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.lingshondaparts.com/honda_car_parts_select_VIN_C20", NewWindow:=True
End Sub


Private Sub MyPartNumber_AfterUpdate()
'Set the background to grey (in case its currently red due to an incorrect length part number having been entered)
Me.MyPartNumber.BackColor = RGB(180, 180, 180)
If MyPartNumber.Text = "" Then Exit Sub


'Add - characters if 11 part number is 11 characters long
If Len(Me.MyPartNumber.Value) = 11 Then Me.MyPartNumber.Value = Left(Me.MyPartNumber.Value, 5) & "-" & Mid(Me.MyPartNumber.Value, 6, 3) & "-" & Right(Me.MyPartNumber.Value, 3)


'Turn background red if part number is wrong length
If Len(Me.MyPartNumber.Value) <> 13 Then
Me.MyPartNumber.BackColor = RGB(255, 0, 0)
Me.MyPartNumber.SetFocus
Exit Sub
End If


'Check to see if value exists
If WorksheetFunction.CountIf(Sheet8.Range("Y:Y"), Me.MyPartNumber.Value) = 0 Then
PartNumberMessage.Show
Me.MyPartNumber.Value = ""
Me.MyPartNumber.SetFocus
Exit Sub
End If


'Lookup values based on first control
With Me
.HondaPartNumber = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 2, 0)
.NumbersOnCase = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 3, 0)
.NumbersOnPcb = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 4, 0)
.Buttons = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 5, 0)
.GoldSwitchesOnPcb = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 6, 0)
.ItemType = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 7, 0)
.Notes = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 8, 0)
.Upgrade = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 9, 0)
.MyPrice = Format(Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 10, 0), "£#,##0.00")
End With
End Sub


Private Sub Notes_Change()
If Me.Notes.Value <> vbNullString Then
 Me.Notes.BackColor = RGB(255, 255, 0) ' yellow
Else
Me.Notes.BackColor = RGB(255, 255, 255)
End If
End Sub


Private Sub PartNumber2012_Click()
Hondapn2012.Show
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, _
  CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then
    Cancel = True
    CloseMessage.Show
  End If
End Sub


Private Sub Upgrade_Change()
    FlashTextBox Me.Upgrade, True
End Sub




Private Sub Upgrade_Enter()
    FlashTextBox Me.Upgrade, True
End Sub




Private Sub Upgrade_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    FlashTextBox Me.Upgrade, False
End Sub


Private Sub FlashTextBox(ByVal Ctl As Control, ByVal Enabled As Boolean)
    On Error Resume Next
    KillTimer GetForegroundWindow, lIDEvent
    If Not Enabled Then Ctl.BackColor = &H80000005: Exit Sub
    If Ctl.Text <> vbNullString Then
        SetTimer GetForegroundWindow, ObjPtr(Ctl), FLASH_RATE, AddressOf FlashProc
    Else
        KillTimer GetForegroundWindow, lIDEvent
        Ctl.BackColor = vbRed
    End If
End Sub

 

[ipbr21054]

Here is a download link for sharing.
http://www.mediafire.com/file/z258puvssymh0zv/SHARE.zip

To test the issue out please below,
Go to Honda Sheet.
Click on the Check button.
Form now opens.
Honda Part Number is select so enter 72147s9a999
Now press Check
You will now see the message box pop up.
Close the message box down then see where the flashing cursor in now situated.

Thanks