Cell's value determines range's entry or creates drop down menu

MrMurphy

New Member
Joined
Mar 15, 2018
Messages
12
Hi,
I'm curious whether it would be possible (likely VBA) to allow a cell's value to either update a range to mirror the value of a cell or to insert a drop down menu into each cell in the range.
Specifically, I have a dropdown menu in B1 that allows for three options. If Option1 or Option2 is selected in B1, the range (C1-C20) would mirror the value in B1. If Option 3 is selected in B1, I'd like to have a drop down menu in each cell of the range with three options (Option1, Option2 or null); yes Option1 and Option2 in the dropdown would be the same as available in B1 dropdown, but now excluding Option 3 and adding null.

I'd also like for the values in the range change whenever the value in B1 changes.


Any thoughts or information you'd be able to provide would be greatly appreciated.


Thanks and regards
 
Hello again!

I am looking to add a level of protection to the sheet by password protecting the worksheet and file. I'm receiving a 'Run Time error '1004': Application-defined or object-defined error', which is debugging to the line .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Choices". Is there a way to protect the sheet and successfully run this code as well? The code, when not protected is great and accomplishes exactly what I need. Possibly any other code I could add to allow for this to execute on a protected sheet? I did confirm the cells referenced are not locked.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B20,F22")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim Choices As String
Choices = "Parts, Tires"
If Target.Column = 2 Then
Range("B27:B76").Validation.Delete
Range("B27:B76").ClearContents
Select Case Target.Value
Case "Parts", "Tires"
Range("B27:B76") = Target
Case "Both"
With Range("B27:B76").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Choices
End With
End Select
ElseIf Target.Column = 6 Then
If Range("F22").Value = "10" Then
Me.CommandButton1.Visible = True
Else
Me.CommandButton1.Visible = False
End If
End If
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Try:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B20,F22")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="MyPassword"
    Application.ScreenUpdating = False
    Dim Choices As String
    Choices = "Parts, Tires"
    If Target.Column = 2 Then
        Range("B27:B76").Validation.Delete
        Range("B27:B76").ClearContents
        Select Case Target.Value
            Case "Parts", "Tires"
                Range("B27:B76") = Target
            Case "Both"
                With Range("B27:B76").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Choices
                End With
        End Select
    ElseIf Target.Column = 6 Then
        If Range("F22").Value = "10" Then
            Me.CommandButton1.Visible = True
        Else
            Me.CommandButton1.Visible = False
        End If
    End If
    Application.ScreenUpdating = True
    ActiveSheet.Protect Password:="MyPassword"
End Sub
Change "MyPassword" (2 occurrences) to your actual password.

If you want to protect your macros so no one can see them, you have to protect your VBA Project. Do the following:
-hold down the ALT key and press the F11 key to open the Visual Basic Editor
-click on 'Tools' on the top menu
-click 'VBAProject Properties'
-click the 'Protection' tab
-click the box to the left of 'Lock project for viewing' to put a check mark in it
-enter your password and then confirm it and click 'OK'
-close the VB Editor
-save your file as a macro-enabled file
When you re-open the file, you will not be able to see the macros unless you enter the password. Keep in mind that this type of protection is not very strong and anyone who really wants to get at your macros can probably do it with a little research. I hope this helps.
 
Upvote 0
Hello again!

After some further use on the spreadsheet, I'm now looking to add an additional check in the Change Sub. With the new section in the Change sub, I'm looking to hide Rows 14 and 15 if the value in cell B9 is "New Customer" or null. Otherwise, if B9 is "Current Customer", Rows 14 and 15 should be visible/not hidden. I've been playing around to try to get it, but I'm still off somewhere/somehow. I'm not exactly clear on the when to end If statements, when to use ElseIf and the whether one option (Ending an IF/ElseIf, would exclude further lines of code). Any help with the following would be appreciated.



Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B21,F25")) Is Nothing Then Exit Sub
ActiveSheet.Unprotect Password:="##########"
Application.ScreenUpdating = False

Dim Choices As String
Choices = "Parts, Tires"
If Target.Column = 2 Then
Range("B31:B80").Validation.Delete
Range("B31:B80").ClearContents
Select Case Target.Value
Case "Parts", "Tires"
Range("B31:B80") = Target
Case "Both"
With Range("B31:B80").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Choices
End With
End Select

'Hide Button until all 12 required header fields are populated
ElseIf Target.Column = 6 Then
If Range("F25").Value = "12" Then
Me.CommandButton1.Visible = True
Else
Me.CommandButton1.Visible = False

'Hide Rows if Customer Status = Current Customer
If Target.Column = 2 Then
If Range("B9").Value = "New Customer" Or IsNull("B9") Then
Rows("14:15").Select
Selection.EntireRow.Hidden = True
Range("B9").Select
ElseIf Range("B9").Value = "Current Customer" Then
Rows("14:15").Select
Selection.EntireRow.Hidden = False
End If
End If
End If
End If

Application.ScreenUpdating = True
ActiveSheet.Protect Password:="##########"
End Sub
 
Upvote 0
Try:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B21,B29,F25")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="##########"
    Application.ScreenUpdating = False
    Dim Choices As String
    Choices = "Parts, Tires"
    If Target.Address = "$B$21" Then
        Range("B31:B80").Validation.Delete
        Range("B31:B80").ClearContents
        Select Case Target.Value
            Case "Parts", "Tires"
                Range("B31:B80") = Target
            Case "Both"
                With Range("B31:B80").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Choices
                End With
        End Select
    'Hide Button until all 12 required header fields are populated
    ElseIf Target.Address = "$F$25" Then
        If Target = "12" Then
            Me.CommandButton1.Visible = True
        Else
            Me.CommandButton1.Visible = False
        End If
    ElseIf Target.Address = "$B$9" Then
    'Hide Rows if Customer Status = Current Customer
        Select Case Target.Value
            Case "New Customer", ""
                Rows("14:15").EntireRow.Hidden = True
            Case "Current Customer"
                Rows("14:15").EntireRow.Hidden = False
        End Select
    End If
    Application.ScreenUpdating = True
    ActiveSheet.Protect Password:="##########"
End Sub
Just a reminder that when you post code, you should use code tags. To do so, highlight your code and click the # sign in the menu. The best way to write code is to use indenting to group the loops. If you look at the macro I suggested you can see a good example of how to do that. This makes it easier to check if any If's, End If's, etc. are missing.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top