Create validation list with Worksheet_change
 

I have this code to place a validation list in cell A9 every time any cell
from A41 and down below changes. Then under if a value es selected i'll
change B9

Am I missing anythin? doesn't work

Private Sub Worksheet_Change(ByVal Target As Range)
''''''''''Creates validation list with month's dates
Dim r As Range, txt As String

If Target.Row 40 And Target.Column = 1 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect

For Each r In Range("A41", Range("A" & Rows.Count).End(xlUp))
If Not IsEmpty(r) Then txt = txt & "," & r.Value
Next
With Range("A9")
.Value = Empty
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Mid$(txt, 2)
End With
.Select
End With

Range("B9").Value = ""


Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True,
AllowFiltering:=True


End If

If Target = Range("A9") Then
Range("B9") = WorksheetFunction.Text(ActiveSheet.Range("A9").Val ue, "DDD")
' DoIt
End If
End Sub


Thanks in advance

Create validation list with Worksheet_change
 

Hi

Unprotect sheet ect. at the top off the sub and protect ect. just
before end sub. I assume that column A is unlocked when the sheet is
protected...

Private Sub Worksheet_Change(ByVal Target As Range)
''''''''''Creates validation list with month's dates
Dim r As Range, txt As String

Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect

If Target.Row 40 And Target.Column = 1 Then
For Each r In Range("A41", Range("A" & Rows.Count).End(xlUp))
If Not IsEmpty(r) Then txt = txt & "," & r.Value
Next
With Range("A9")
.Value = Empty
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Mid$(txt, 2)
End With
.Select
End With
Range("B9").Value = ""
End If

If Target = Range("A9") Then
Range("B9") = WorksheetFunction.Text(ActiveSheet.Range
("A9").Value, "DDD")
' DoIt
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True, AllowFiltering:=True
End Sub

Regerds,
Per

On 28 Mar., 03:14, LuisE wrote:
I have this code to place a validation list in cell A9 every time any cell
from A41 and down below changes. Then under if a value es selected i'll
change B9

Am I missing anythin? * doesn't work

Private Sub Worksheet_Change(ByVal Target As Range)
*''''''''''Creates validation list with month's dates
* * Dim r As Range, txt As String

* * If Target.Row 40 And Target.Column = 1 Then
* * Application.EnableEvents = False
* * Application.ScreenUpdating = False
* * ActiveSheet.Unprotect

* * For Each r In Range("A41", Range("A" & Rows.Count).End(xlUp))
* * * * If Not IsEmpty(r) Then txt = txt & "," & r.Value
* * Next
* * With Range("A9")
* * * * .Value = Empty
* * * * With .Validation
* * * * * * .Delete
* * * * * * .Add Type:=xlValidateList, Formula1:=Mid$(txt, 2)
* * * * End With
* * * * .Select
* * End With

*Range("B9").Value = ""

* * Application.EnableEvents = True
* * Application.ScreenUpdating = True
* ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True,
AllowFiltering:=True

* * End If

If Target = Range("A9") Then
* Range("B9") = WorksheetFunction.Text(ActiveSheet.Range("A9").Val ue, "DDD")
' *DoIt
End If
End Sub

Thanks in advance