Here is a modify version of some code I use to check for a qualified
user.
Sub ConfirmUser()
Dim bolUser As Boolean
bolUser = CheckUser(Environ("USERNAME"))
If bolUser = True Then
If Application.UserName <> "" Then
Range("B1") = Application.UserName
Else
Range("B1") = Environ("USERNAME")
End If
End If
End Sub
Function CheckUser(strUser As String) As Boolean
Dim arrTeam(0 To 8) As String
Dim intCount As Integer
arrTeam(0) = "user1"
arrTeam(1) = "user2"
arrTeam(2) = "user3"
arrTeam(3) = "user4"
arrTeam(4) = "user5"
arrTeam(5) = "user6"
arrTeam(6) = "user7"
arrTeam(7) = "user8"
arrTeam(8) = "user9"
On Error GoTo NoUser:
For intCount = 0 To UBound(arrTeam)
If strUser = arrTeam(intCount) Then
CheckUser = True
Exit For
End If
Next intCount
Exit Function
NoUser:
CheckUser = False
End Function