Programar borrado de registro en formulario

Borrar los registros en un formulario después de 5 segundos, se anexa la aplicación que se utiliza

A partir de la fila 157 "borrar registro" se indica la orden, pero creo esta colocado mal porque al ejecutarlo no me muestra los datos, si no inicia el borrado sin mostrar nada de registros, me interesa que muestre registros y después de 5 segundos estos sean borrados incluyendo la imagen

Public ubica As String
Public control As Integer
Public filalibre As Integer
Dim Dato As String

Dim MyData As Range
Dim c As Range
Dim rFound As Range
Dim r As Long
Dim rng As Range
Dim imgFolder As String
Dim sFileName As String
Dim oCtrl As MSForms.control

Private Sub Codigo_Change()
Range("A1").Value = Codigo.Value
End Sub

Private Sub Codigo_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Regresar cursor a codigo
Codigo.SelStart = 0
Codigo.SelLength = Len(Codigo.Text)
Cancel = True

Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True

Saldo.Caption = Range("V1").Value
Saldo = Format(Range("V1").Value, "#,##00.00")
If [Saldo] > "1" Then
Saldo.Visible = True
Label6.Visible = True
End If

If [Saldo] < "1" Then
Saldo.Visible = False
Label6.Visible = False
End If

On Error GoTo IMG_ERROR
Nombre = ""
Importe = ""
Recibo = ""
Convenio = ""
Area = ""
Inicio = ""
Vence = ""
Dim strFind As String 'what to find
Dim FirstAddress As String
Dim rSearch As Range 'range to search
Set rSearch = Sheet2.Range("A3", Range("A4500").End(xlUp))
Dim f As Integer
imgFolder = ThisWorkbook.Path &amp; Application.PathSeparator &amp; "Fotos" &amp; Application.PathSeparator
strFind = Me.Codigo.Value 'what to look for

With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then 'found it
c.Select
With Me 'load entry to form
.Recibo.Caption = c.Offset(0, 0).Value
.Nombre.Caption = c.Offset(0, 1).Value
.Convenio.Caption = c.Offset(0, 12).Value
.Inicio = Format(c.Offset(0, 13).Value, "dd mmmm yy")
.Vence = Format(c.Offset(0, 14).Value, "dd mmmm yy")
.Vence2 = Format(c.Offset(0, 14).Value, "dddd dd mmm yyyy")
.Status.Caption = c.Offset(0, 15).Value
.Dias.Caption = c.Offset(0, 16).Value

sFileName = c.Offset(0, 0).Value

ConvenioArea.Caption = [Convenio].Caption &amp; " " &amp; [Area].Caption
LoadPic
f = 0
End With
FirstAddress = c.Address
Do
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
IMG_ERROR:

If [Status] = "VIGENTE" Then
Status.ForeColor = &amp;H8000&amp;
Dias.ForeColor = &amp;HC000&amp;
Status2.Caption = "P"
Status2.ForeColor = &amp;HC000&amp;
Vence2.Visible = False
End If

If [Status] = "VENCIDO" Then
Status.ForeColor = &amp;HFF&amp;
Dias.ForeColor = &amp;HFF&amp;
Status2.Caption = "O"
Status2.ForeColor = &amp;HFF&amp;
Vence2.Visible = True
End If

'Sonido
Range("U1").Value = Status.Caption
cancion = Range("U1").Value
iResult = mciexecute("Play D:\StarFit\Audio\" &amp; cancion &amp; ".mp3")

'Ingresar asistencia
Application.ScreenUpdating = False
Sheets("Registro de Asistencia").Select
ActiveSheet.Unprotect "contraseña"

Range("A2:A65536").Select
Selection.EntireRow.Hidden = False

Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Range("A1:H1").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("A2").Select

Selection.End(xlDown).Select
ActiveCell.Range("A1:H1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("A3").Select
Selection.End(xlDown).Select
Selection.EntireRow.Hidden = True
Range("A2").Select

ActiveSheet.Protect Password:="contraseña", DrawingObjects:=True, Contents:=True
ActiveSheet.EnableSelection = xlNoRestrictions

Sheets("BD Socio").Select
Range("B3").Select

'Borrar registro
If Codigo = "" Then
Exit Sub
End If

Dim fin As Date
Dim ahora As Date
ahora = Now
fin = DateAdd("s", 5, ahora)
Do While Now <> fin
If Now >= fin Then Exit Do
Loop

Codigo = ""
Nombre = ""
Importe = ""
Recibo = ""
Convenio = ""
Area = ""
Inicio = ""
Vence = ""
ConvenioArea = ""
Status = ""
Status2 = ""
Dias = ""
Vence2 = ""

Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False

Me.Image1.Picture = LoadPicture("")
Application.ScreenUpdating = True
Exit Sub

'Al no encontrar
Else: MsgBox strFind &amp; " codigo no registrado"

Codigo = ""
Nombre = ""
Importe = ""
Recibo = ""
Convenio = ""
Area = ""
Inicio = ""
Vence = ""
ConvenioArea = ""
Status = ""
Status2 = ""
Dias = ""
Vence2 = ""

Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Me.Image1.Picture = LoadPicture("")

End If
End With
End Sub

Private Sub UserForm_Initialize()
Set MyData = Sheet2.Range("a3").CurrentRegion
With Me
.Caption = "StarFit Fitness Center"
End With
Application.Visible = False
End Sub

Sub LoadPic()
On Error GoTo IMG_ERROR
Me.Image1.Picture = LoadPicture(imgFolder &amp; sFileName &amp; ".jpg")
IMG_ERROR:
Exit Sub
End Sub

Private Sub UserForm_Terminate()
Application.Visible = True
End Sub