[Solved] Macro for drop down list.

[arc_poojari]

Hi
I have database having details of sales done by different sales person. Which i need to circulate to all sales person, however i want to put restriction on them of viewing data of other sales person. My excel sheet works on drop down list .Can i have user based restriction in drop down list.

 

[Lutfor Rahman Shimanto]

Hi
I have database having details of sales done by different sales person. Which i need to circulate to all sales person, however i want to put restriction on them of viewing data of other sales person. My excel sheet works on drop down list .Can i have user based restriction in drop down list.

Hello Arc Poojari

Thanks for reaching out and posting your queries with such clarity.

Requirement: You have a database with details of sales done by a different salesperson. You want to restrict them from viewing other salespeople's data. Your Excel sheet works on a drop-down list. You asked to implement a user-based restriction in the drop-down list.

The functionalities you mentioned can be developed with the help of Excel Features and Excel VBA. I am delighted to inform you that I have designed an Excel File for your goal.

Overview:

OVERVIEW VIDEO​

I am also attaching the solution workbook. You have to download the file and unlock it. I will also provide more instructions and necessary codes in the upcoming reply.

Regards
Lutfor Rahman Shimanto

 

[Lutfor Rahman Shimanto]

Hi
I have database having details of sales done by different sales person. Which i need to circulate to all sales person, however i want to put restriction on them of viewing data of other sales person. My excel sheet works on drop down list .Can i have user based restriction in drop down list.

Dear Arc Poojari

Thanks once again for bringing up such an interesting problem. Previously, I have shown you the overview of the whole system. Throughout this reply, I will guide you step-by-step in reaching your goal.

Dataset:

​

Drop-Down:

​

Other Sheets:

​

VBA Code within Drop Down Sheet:

​

Dim SalesRep1 As String
Dim SalesRep2 As String
Dim SalesRep3 As String

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Address = "$B$2" And Target.Parent.Name = "Drop Down" Then
        Call displaySalePurchase
    End If

End Sub

Sub displaySalePurchase()

    Dim dSP1 As Worksheet
    Dim dSP2 As Worksheet
    Dim dSP3 As Worksheet
    Dim SP As Worksheet
    Dim DR As Worksheet
    
    Set dSP1 = ThisWorkbook.Sheets("Sheet1")
    Set dSP2 = ThisWorkbook.Sheets("Sheet2")
    Set dSP3 = ThisWorkbook.Sheets("Sheet3")
    Set SP = ThisWorkbook.Sheets("Sales Data")
    Set DR = ThisWorkbook.Sheets("Drop Down")
    
    Call FindUniqueNames
    
    If DR.Range("B2").Value = SalesRep1 Then
        Call OpenProtectedSheet1
        
        'On Error GoTo ErrorHandler1
        
        SP.AutoFilterMode = False
        SP.UsedRange.AutoFilter Field:=1, Criteria1:=DR.Range("B2").Value
        
'ErrorHandler1:
'        Exit Sub
        
        dSP1.UsedRange.Clear
        
        SP.UsedRange.SpecialCells(xlCellTypeVisible).Copy
        dSP1.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        SP.AutoFilterMode = False
        
        Call UnhideSheet1
        
        dSP1.Activate
        
    ElseIf DR.Range("B2").Value = SalesRep2 Then
        Call OpenProtectedSheet2
        
 '       On Error GoTo ErrorHandler2
        
        'ThisWorkbook.Sheets("Sheet2").Visible = xlSheetVisible
        
        SP.AutoFilterMode = False
        SP.UsedRange.AutoFilter Field:=1, Criteria1:=DR.Range("B2").Value
        
'ErrorHandler2:
'        Exit Sub
        
        dSP2.UsedRange.Clear
        
        SP.UsedRange.SpecialCells(xlCellTypeVisible).Copy
        dSP2.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        SP.AutoFilterMode = False
        
        Call UnhideSheet2
        
        dSP2.Activate
        
    ElseIf DR.Range("B2").Value = SalesRep3 Then
        Call OpenProtectedSheet3
        
'        On Error GoTo ErrorHandler3
        
        SP.AutoFilterMode = False
        SP.UsedRange.AutoFilter Field:=1, Criteria1:=DR.Range("B2").Value
        
'ErrorHandler3:
'        Exit Sub
        
        dSP3.UsedRange.Clear
        
        SP.UsedRange.SpecialCells(xlCellTypeVisible).Copy
        dSP3.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        SP.AutoFilterMode = False
        
        Call UnhideSheet3
        
        dSP3.Activate

    End If

End Sub

Sub FindUniqueNames()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim uniqueNames() As String
    Dim isDuplicate As Boolean
    Dim i As Long, j As Long
    
    Set ws = ThisWorkbook.Sheets("Sales Data")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ReDim uniqueNames(1 To lastRow - 1)
    
    j = 0
    For i = 2 To lastRow
        Dim currentName As String
        currentName = Trim(ws.Cells(i, "A").Value)
        
        isDuplicate = False
        Dim k As Long
        For k = 1 To j
            If uniqueNames(k) = currentName Then
                isDuplicate = True
                Exit For
            End If
        Next k
        
        If Not isDuplicate Then
            j = j + 1
            uniqueNames(j) = currentName
        End If
    Next i
    
    ReDim Preserve uniqueNames(1 To j)
    
    SalesRep1 = uniqueNames(1)
    SalesRep2 = uniqueNames(2)
    SalesRep3 = uniqueNames(3)

End Sub

Sub OpenProtectedSheet1()
    
    Dim actualPassword As String
    Dim enteredPassword As String
    
    actualPassword = "John123"
    
    enteredPassword = InputBox("Enter the password to access the protected sheet:", "Password Required")
    
    If enteredPassword = actualPassword Then
        ThisWorkbook.Sheets("Sheet1").Unprotect Password:=actualPassword
        
        MsgBox "Welcome!"
    Else
        MsgBox "Incorrect password. Access denied.", vbExclamation
    End If

End Sub

Sub OpenProtectedSheet2()
    
    Dim actualPassword As String
    Dim enteredPassword As String
    
    actualPassword = "Jane123"
    
    enteredPassword = InputBox("Enter the password to access the protected sheet:", "Password Required")
    
    If enteredPassword = actualPassword Then
        ThisWorkbook.Sheets("Sheet2").Unprotect Password:=actualPassword
        
        MsgBox "Welcome!"
    Else
        MsgBox "Incorrect password. Access denied.", vbExclamation
    End If

End Sub

Sub OpenProtectedSheet3()
    
    Dim actualPassword As String
    Dim enteredPassword As String
    
    actualPassword = "Mark123"
    
    enteredPassword = InputBox("Enter the password to access the protected sheet:", "Password Required")
    
    If enteredPassword = actualPassword Then
        ThisWorkbook.Sheets("Sheet3").Unprotect Password:=actualPassword
        
        MsgBox "Welcome!"
    Else
        MsgBox "Incorrect password. Access denied.", vbExclamation
    End If

End Sub

Sub UnhideSheet1()

    ThisWorkbook.Sheets("Sheet2").Visible = xlSheetVisible

End Sub

Sub UnhideSheet2()

    ThisWorkbook.Sheets("Sheet2").Visible = xlSheetVisible

End Sub

Sub UnhideSheet3()

    ThisWorkbook.Sheets("Sheet3").Visible = xlSheetVisible

End Sub

VBA Code within Workbook:

​

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    
    Dim passwordSheet1 As String
    Dim passwordSheet2 As String
    Dim passwordSheet3 As String
    
    passwordSheet1 = "John123"
    passwordSheet2 = "Jane123"
    passwordSheet3 = "Mark123"
    
    Select Case Sh.Name
        Case "Sheet1"
            Sh.Protect Password:=passwordSheet1
            Sh.Visible = xlSheetHidden
        Case "Sheet2"
            Sh.Protect Password:=passwordSheet2
            Sh.Visible = xlSheetHidden
        Case "Sheet3"
            Sh.Protect Password:=passwordSheet3
            Sh.Visible = xlSheetHidden
    End Select

End Sub

Let me know if you want to learn the whole procedure in more detail or how the code works. Stay blessed, and good luck.

Regards
Lutfor Rahman Shimanto