I need the VBA message box should open and close automatically while macro is running

I am using the below code to receive the output from DB. The code will take the data from DB and keep in Excel sheet.
I need the VBA message box should open and close automatically while macro is running.Please help me to solve this.

Private Sub PIN_Click()
Dim x As Workbook
Set x = Workbooks.Open("C:\Test data.xlsx")
a = WorksheetFunction.CountA(Worksheets(1).Columns(2))
For i = 2 To a
ssn = x.Sheets("Sheet1").Range("B" & i).Value
ssn = "'" & ssn & "'"
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open database, TextBox1.Value, TextBox2.Value
Sql = "select sso.FUNC_DECRYPT_STR (password) from SSO.SSO_USER where sso_user_id =" & ssn
rs.Open Sql, conn
Set rs = conn.Execute(Sql)
If Not rs.EOF Then
Excel.Workbooks("Test data.xlsx").Worksheets("Sheet1").Range("I" & i).Value = rs.Fields(0).Value
Else

Excel.Workbooks("Test data.xlsx").Worksheets("Sheet1").Range("I" & i).Value = "Data not found"
End If
rs.Close

Sql = "select sso.FUNC_DECRYPT_STR(ALPHA_PASSWORD)  from SSO.SSO_USER where sso_user_id =" & ssn
rs.Open Sql, conn
Set rs = conn.Execute(Sql)
If Not rs.EOF Then
Excel.Workbooks("Test data.xlsx").Worksheets("Sheet1").Range("J" & i).Value = rs.Fields(0).Value

Else
Excel.Workbooks("Test data.xlsx").Worksheets("Sheet1").Range("J" & i).Value = "Data not found"
End If
rs.Close