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").Value, "DDD")
' DoIt
End If
End Sub


Thanks in advance

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 <legonza...@yahoo.com> 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").Value,"DDD")
> ' *DoIt
> End If
> End Sub
>
> Thanks in advance