Monday, October 16, 2017

Excel dropdowns from arrays in a protected worksheet where only the cells fixed for dropdown is allowed to change in VBA,VBA Teacher Sourav,Kolkata 09748184075

Private Sub Workbook_Open()
Sheets("Sheet1").Select



Application.Calculation = xlManual

Call calldropdown

On Error Resume Next
ActiveSheet.Protect Password:="0000"



End Sub




Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet
Dim inputRange As Range


Set ws = Worksheets("Sheet1")
'tell this sub to unprotect only these cells
Set inputRange = Range("G1,I1,M1,O1")


' If the selected cell is not in the range keep the sheet locked
If Intersect(Target, inputRange) Is Nothing Then
'else unprotect the sheet by providing password
'(same as the one that was used to protect this sheet)
Else

    ws.Unprotect Password:="0000"
    Target.Locked = False
    ws.Protect Password:="0000"

End If
End Sub


Sub dropdown(pos As String, ByRef valdropdown() As String)
'
' Macro1 Macro
'

'


Set ws = Worksheets("Sheet1")
ws.Select

  
   
Range(pos).Select
ws.Unprotect Password:="0000"
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(valdropdown, ",")
       
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
   
   
    ws.Protect Password:="0000"
End Sub

Sub testarr()
 Dim valG1() As String
 valG1 = Split("A, B, C", ",")

 testarr2 valG1

End Sub

Sub testarr2(ByRef valG1() As String)
MsgBox (UBound(valG1))

End Sub


Sub calldropdown()

Sheets("Sheet1").Select

Dim valG1() As String
 valG1 = Split("A, B, C", ",")
 Dim valI1() As String
 valI1 = Split("L, M, N", ",")
 Dim valM1() As String
 valM1 = Split("X, Y, Z", ",")
 Dim valO1() As String
 valO1 = Split("1, 2, 3", ",")



Call dropdown("G1", valG1)

Call dropdown("I1", valI1)
Call dropdown("M1", valM1)
Call dropdown("O1", valO1)



End Sub



No comments:

Post a Comment