Home » excel » excel – Check if Username exists in range using VBA

excel – Check if Username exists in range using VBA

Posted by: admin May 14, 2020 Leave a comment

Questions:

I have the following Excel spreadsheet:

     A         B        C         D       E
1            Username1
2            Username2
3            Username3
4            Username4
5            
6

In Range B1:B4 I am listing all users that should be allowed to run the following VBA:

Sub Button_Value()
If Environ("Username") = Sheet1.Range("B1") _
Or Environ("Username") = Sheet1.Range("B2") _
Or Environ("Username") = Sheet1.Range("B3") _
Or Environ("Username") = Sheet1.Range("B4") Then
Sheet1.Range("A1").Value = 3
Else
Answer = MsgBox("Function not available")
End If
End Sub

All this works perfectly.


However, no I am wondering if there is a way to check if the Username exists in Range B1:B4 so I do not have to use an OR function for each new user that I want to add?

How to&Answers:
Sub Button_Value()

    If userExists Then
       Sheet1.Range("A1").Value = 3
    Else
       Msgbox "Function Not Available"
    End If

End Sub

Function userExists() as Boolean

    Dim user as String
    user = Environ("username")

    userExists = IsNumeric(Application.match(user,Sheet1.Range("B1:B4"),0))

End Function

Answer:

You could use Range.Find like this:

Dim rng As Range

With Sheet1
    Set rng = .Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp))
    If Not rng.Find(Environ("Username")) Is Nothing Then
        .Cells(1, 1).Value = 3
    Else
        Answer = MsgBox("Function not available")
    End If
End With

This will also adjust to how many user names are in column B.

Answer:

Based on the comments and the answers there are the following two options to solve the issue:

Option A (Application.Match)

Sub Button_Value()
If Not IsError(Application.Match(Environ("Username"), Sheet1.Range("B1:B4"), 0)) Then
Sheet1.Range("A1").Value = 3
Else
Answer = MsgBox("Function not available")
End If
End Sub

Option B (Range.Find)

Sub Button_Value()
With Sheet1
    Set Rng = Sheet.Range("B1:B4")
    If Not Rng.Find(Environ("Username")) Is Nothing Then
    Sheet1.Range("A1").Value = 3
    Else
     Answer = MsgBox("Function not available")
    End If
End With
End Sub

Answer:

I know you have two answers but heres a third using a dictionary to check whether the username exists:

            Sub test()
            Dim username As String 'declare the username
            Dim r As Range: Set r = Sheet1.Range("B1:B4") 'dim and set your range
            Dim UserNames As Scripting.Dictionary 'dim dictionary
                Set UserNameDic = New Scripting.Dictionary 'set your dictionary to a new one
            Dim x As Integer 'counter just for the dictionary value
                x = 1

            'loops through each cell in your range
            For Each u In r
                UserNameDic.Add u.Value, x 'adds your username to the dictionary
                x = x + 1
            Next

            If Not UserNameDic.Exists(Environ("username")) Then: MsgBox "Access      Denied" 'checks to see if the username exisits in the dictionary
            End Sub