I have a sheet where there are two columns (Column C and column E). Column E has cells with dropdown menus that are dependent on the value of the cells in the same row, Column C.
I am trying to get the value in Column E to automatically change to the first option of the new corresponding dropdown menu when the value in Column C changes. As it stands, when the value in Column C changes, the value from before in the respective Column E cell remains, and I have to manually click and select from the new list.
Here is what I have to start:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng(1) As Range, rng1 As Range
Set rng(0) = Range("C71:C91")
Set rng(1) = Range("E71:E91")
Application.EnableEvents = False
If Not Intersect(Target, rng(0)) Is Nothing Then
For Each rng1 In rng(1)
i = i 1
rng1 = Range("" & rng(0).Value2)(i, 1)
Next
End If
Application.EnableEvents = True
End Sub
CodePudding user response:
Haven't fully tested the code, but can see a basic bug. Line:
For Each rng1 In rng(1)
Should read:
For Each rng1 In rng(1).Cells
CodePudding user response:
Recalculate the sheet with Application.CalculateFull
after your if statement.
CodePudding user response:
A Worksheet Change with Data Validation (Drop-Downs)
- It is assumed that the drop-downs in
E71:E91
'get' the values fromC71:C91
and that when you change (manually or via VBA) a value inC71:C91
, the value in the same row ofE71:E91
will be overwritten with this value. - Out-comment or delete the
Debug.Print
lines when done testing.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print "Worksheet Change Sequence at " & Now
Debug.Print "1. '" & Target.Address(0, 0) & "' has changed."
Dim srg As Range: Set srg = Range("C71:C91")
Dim drg As Range: Set drg = Range("E71:E91")
Dim irg As Range: Set irg = Intersect(srg, Target)
Debug.Print "2. Range references created."
If irg Is Nothing Then
Debug.Print "3. No intersecting range. Exiting."
Exit Sub
Else
Debug.Print "3. Intersecting range at '" & irg.Address(0, 0) & "'."
End If
On Error GoTo ClearError
Application.EnableEvents = False
Debug.Print "4. Error handler activated. Events disabled."
' Write to intersecting rows only.
Dim dCol As Long: dCol = drg.Column
Dim iCell As Range
For Each iCell In irg.Cells
iCell.EntireRow.Columns(dCol).Value = iCell.Value
Next iCell
Debug.Print "5. Written to '" _
& Intersect(irg.EntireRow, drg).Address(0, 0) & "'."
'Or:
' Write to whole destination range.
'drg.Value = srg.Value
'Debug.Print "5. Written to '" & drg.Address(0, 0) & "'."
SafeExit:
Application.EnableEvents = True
Debug.Print "6. Events enabled. Exiting."
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
' Multi-range example. Best run from 'VBE' with the Immediate window open.
Sub Test()
Range("C71,C73,C75").Value = "A"
Range("C73,C75").Value = "B"
Range("C75").Value = "C"
End Sub