Dropdown with values from different sheet and showing the first element of the list in the dropdown cell using vba

Sub autofill1()
'
' Macro1 Macro
'

'
'For C column autifilling

Sheets("Service Catalogue").Select
 Dim inputRange As Range

    Range("C6").Select
   
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Services"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
       
    End With
    Dim namedrange As Range
    Set namedrange = Range("Services")
    ActiveCell.Value = (namedrange.cells(1, 1).Value)
   
   
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
   
     Dim dd As DropDown

   
  'For D column autofilling
 
    Sheets("Service Catalogue").Select

    Range("D6").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=INDIRECT(C6)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
  
  


   
 Set inputRange = Evaluate(Range("D6").Validation.Formula1)
  Range("D6").Select
  ActiveCell.Value = inputRange(1)
  Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
   'For E column autofilling
  
    Sheets("Service Catalogue").Select

    Range("E6").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=INDIRECT(D6)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
  
    Set inputRange = Evaluate(Range("E6").Validation.Formula1)
  Range("E6").Select
  ActiveCell.Value = inputRange(1)
  Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
   'For F column autofilling
  
   Sheets("Service Catalogue").Select

    Range("F6").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=INDIRECT(E6)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
  
  
    Set inputRange = Evaluate(Range("F6").Validation.Formula1)
  Range("F6").Select
  ActiveCell.Value = inputRange(1)
  Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
       
         'For G column autofilling
  
   Sheets("Service Catalogue").Select

    Range("G6").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Selection"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
  
  
    Set inputRange = Evaluate(Range("G6").Validation.Formula1)
  Range("G6").Select
  ActiveCell.Value = inputRange(1)
  Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
       
       
          
         'For H column autofilling
  
   Sheets("Service Catalogue").Select

    Range("H6").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=INDIRECT(G6)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
  
  
    Set inputRange = Evaluate(Range("H6").Validation.Formula1)
  Range("H6").Select
  ActiveCell.Value = inputRange(1)
  Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
       
          'For I column autofilling
  
   Sheets("Service Catalogue").Select

    Range("I6").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Infra"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
  
  
    Set inputRange = Evaluate(Range("I6").Validation.Formula1)
  Range("I6").Select
  ActiveCell.Value = inputRange(1)
  Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
       
         'For I column autofilling
  
   Sheets("Service Catalogue").Select

    Range("J6").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=SelectionTS"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
  
  
    Set inputRange = Evaluate(Range("J6").Validation.Formula1)
  Range("J6").Select
  ActiveCell.Value = inputRange(1)
  Selection.AutoFill Destination:=ActiveCell.Range("A1:A18"), Type:= _
        xlFillDefault
       
       
       
End Sub

If Column G entered is “NO”, Colum “H” will be protected. If Column G entered is “YES”, column H will be unprotected scenario in vba,VBA Teacher Sourav,Kolkata 09748184075

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
ActiveWorkbook.Save
Sheets("Sheet1").Select
ActiveSheet.Unprotect Password:="0000"
Dim cells As Range
Set cells = ActiveSheet.Range("H:H")


cells.Locked = True
ActiveSheet.Protect Password:="0000"

End Sub

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



Application.Calculation = xlManual

Call calldropdown

Sheets("Sheet1").Select
'ActiveSheet.Unprotect Password:="0000"
'Dim cells As Range
'Set cells = ActiveSheet.Range("H:H")
'ActiveSheet.cells.Select

'cells.Locked = True

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 test1()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim cells As Range
Dim workingsheet As Worksheet
Set workingsheet = Worksheets("Sheet1")
Set cells = workingsheet.Range("H:H")

Sheets("Sheet1").Activate

Range("G1").Select
If ActiveCell.Value = "YES" Then
'MsgBox ("Hello")

workingsheet.Unprotect Password:="0000"
cells.Locked = False
'cells.Value = "Got it"
 workingsheet.Protect Password:="0000"
 Else
 workingsheet.Unprotect Password:="0000"
cells.Locked = True

'cells.Value = "Got it"
 workingsheet.Protect Password:="0000"
 End If

Application.ScreenUpdating = True
Application.EnableEvents = True



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("YES, NO", ",")
 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

conditionally unlock a cell using vba,vba teacher sourav,Kolkata 09748184075

Sub test1()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim cells As Range
Dim workingsheet As Worksheet
Set workingsheet = Worksheets("Sheet1")
Set cells = workingsheet.Range("G5")

Sheets("Sheet1").Activate

Range("G1").Select
If ActiveCell.Value = "A" Then
workingsheet.Unprotect Password:="0000"
cells.Locked = False
cells.Value = "Got it"
 workingsheet.Protect Password:="0000"
 Else

 End If

Application.ScreenUpdating = True
Application.EnableEvents = True



End Sub

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

Reset your vba project password,VBA Teacher Sourav,Kolkata 09748184075

https://www.youtube.com/watch?v=Lpt-DbXPPJc



Follow the steps in this video