Microsoft Excel - VBA- Applying value to range of cells not working if enter is pressed

I have the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vCell As Range


For Each vCell In Selection
   If vCell.Value <> ActiveCell.Value And vCell.Validation.Type = xlValidateList Then
        vCell.Value = ActiveCell.Value
End If
Next
End Sub

The code runs fine if the value entered from a data validation list, or if the current time is entered using CTRL + SHIFT + ; but if a value is typed in, it only applies to the active cell. It should add the value to all cells in the range (provided the value is valid in cells with data validation). As I say, it does precisely that if the value is entered using the keyboard shortcut or a selection from a drop down list.

I have noticed that when I type in the value and hit enter, the next cell in the range is activated, and this happens even if I deselect it in Options.

John,

In options even if you deslect the movement direction it still moves down?

Thanks for the reply; I have tried that and it still moves down with data only entered in the first cell.

I put this test code in:

Thank you so much- works perfectly Wally-eye. I have managed to add a macro that clears all cells where the value added by your code does not meet the data validation. Of course, as the value is then changed, it creates a loop, but I have managed to only run the code in the worksheet change event if the cells are being changed by the user and not if through my macro running. There is probably a cleaner way, but this works fine.

Thanks again!

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.EnableSound = True Then


Dim celcurr     As Excel.Range
 
Debug.Print Target.Address
Debug.Print ActiveCell.Address
Debug.Print Selection.Address
If Target.Cells.Count = 1 Then
  Application.EnableEvents = False
  For Each celcurr In Selection.Cells
    Debug.Print celcurr.Address, celcurr.Value
    If celcurr <> Target Then
      celcurr.Value = Target.Value
    End If
  Next celcurr
 End If


  Application.EnableEvents = True
End If
Call Valid
End Sub


Sub Valid()
If Application.EnableSound = True Then
Application.EnableEvents = True
Application.EnableSound = False
Dim vCell As Excel.Range
For Each vCell In Selection
If vCell.Validation.Value = False Then
    vCell.ClearContents
End If
Next vCell
Application.EnableSound = True
End If
End Sub

One problem I have found is that if the sheet is protected, although if a value is selected from a validation drop down list, all selected cells are populated, if a number is typed in, only the cell below the active cell is populated. I have tried using code to unprotect the sheet before the code runs, but it doesn't make any difference. If the sheet has been manually uprotected, the code works fine.

OK, I found a solution to the problem with running the code on a protected sheet. Starting the macro with unprotecting the sheet seems to cause the macro to not run correctly, but if I unprotect it in the selection change event rater than in the change event where the main code is located, it works fine:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim celcurr     As Excel.Range
       Debug.Print Target.Address
Debug.Print ActiveCell.Address
Debug.Print Selection.Address
If Target.Cells.Count = 1 Then
  Application.EnableEvents = False
  For Each celcurr In Selection.Cells
    Debug.Print celcurr.Address, celcurr.Value
    If celcurr <> Target Then
      celcurr.Value = Target.Value
    End If
  Next celcurr
  Application.EnableEvents = True
End If
ActiveSheet.Protect Password:="ab"
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect Password:="ab"
End Sub

You might want to restrict the range of where the unprotect is triggered, something like:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    if not intersect(target, range("A4:B10")) is nothing then
    ActiveSheet.Unprotect Password:="ab"
    else
      ActiveSheet.Protect Password="ab"
    endif

End Sub

which will only unprotect it when cells in the A4:B10 range are selected, else it will just unprotect the entire sheet and leave it unprotected (unless something else protects it in another procedure).

Thanks Wally- just what I was thinking:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim SelCells As Variant
Set SelCells = Selection
If SelCells.Rows.Count > 50 Then
ActiveSheet.Cells(1, 1).Select
Exit Sub
End If
ActiveSheet.Unprotect Password:="CWS"
Application.MoveAfterReturn = False
If ActiveCell.Locked = True Then
ActiveSheet.Protect Password:="CWS"
MsgBox "Cell/s locked and cannot be edited. You will now be taken to the first unlocked cell on the sheet"
ActiveSheet.Cells(6, 3).Activate
End If


The" If SelCells.Rows.Count > 50" is to prevent an overfolw error occuring if the user selects the whole sheet.
Dim R As Range
    Dim RR As Range
    
 For Each R In Selection.Cells
    
           If R.Locked = False Then
           If RR Is Nothing Then
                Set RR = R
                Else
                Set RR = Application.Union(RR, R)
           End If
           End If
 Next R
    If Not RR Is Nothing Then
        RR.Select
    End If
End Sub