Microsoft Excel - Target value to selection but not next cell clicked

I have the following code to apply the same value to all cells in a selection:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For Each c In Selection.Cells
c.Value = Target.Value
Next c
Application.EnableEvents = True
End Sub

The code works fine, except for where the user types the value into the cell and then clicks another cell- the cell clicked into also gets the target vale.

I know I could use Ctrl + Return but the problem with that is that some cells have a data validation list and Ctrl +Return doesn't work for that.

Hello John,
This is a bit clunky but it seems to fix your problem.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strTAdd As String, strSAdd As String
strTAdd = Replace(Target.Address, "$", "")
strSAdd = Selection.Cells(1).Address(0, 0)

Application.EnableEvents = False
If strTAdd = strSAdd Then
For Each c In Selection.Cells
c.Value = Target.Value
Next c
End If
Application.EnableEvents = True
End Sub

Regards
Harry

Hi John,
A slightly less clunky and more general fix (doesn't rely on highlighted cell being in top left corner).

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Selection) Is Nothing Then
For Each c In Selection.Cells
c.Value = Target.Value
Next c
End If
Application.EnableEvents = True
End Sub

Regards
Harry

Thans Harry, it works great.
This may be a long shot, but what would be ideal would be if when user clicks on another cell rather that hitting enter, the ame thing happens- I have observed thatn many users don't use enter and simply click on the another cell.

Hi John,
I don't think this would be possible without somehow having the selected range (Selection) as a Global Variable because when you click on another cell that cell becomes the Target and the Selection and all bets are off.  Off the top of my head, I can't think of any way of preserving the details of the original selection but if you "could" then it might be possible to set the values required.  I will browse around some more to see if anything pops up.
In the meantime you'll just have to educate your users /;-{)}
Regards
Harry

Hello John
This seems to work but the data entry has to be in the top left cell of the selected range (at the moment) for the select another cell case.  It also assumes that they only select one cell.  The enter/tab etc case works the same as before.  If the cells that you are filling are always empty cells then it would be possible to set the each cell value to the non-zero value in the range but if you are over-writing you might be stuck with the top-left option.
Option Explicit

Dim rngBig As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
If Not Intersect(Target, Selection) Is Nothing Then
For Each c In Selection.Cells
c.Value = Target.Value
Next c
End If
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngCell As Range

If Selection.Count > 1 Then
Set rngBig = Selection
Else
For Each rngCell In rngBig
    rngCell.Value = rngBig.Cells(1, 1).Value
Next rngCell
End If

End Sub

Regards
Harry

Good afternoon Harry- thanks very much for your posts- I might have ago at ammending your code to get past the requirement of entering data in the top left most cell of the selection, although I suspect I'm out of my depth!

At the moment, I'm using the original code, but I have wrapped it in an IF statement with required that Selection.Cells.Count > 1

Kind regards,
John

Hi John,
The following modified version will work if you are filling empty cells or if the new value is greater in value that any already existing value.  If the range was already filled and the new value was not also the maximum in the range the the situation is a bit more complex.

Option Explicit

Dim rngBig As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
If Not Intersect(Target, Selection) Is Nothing Then
For Each c In Selection.Cells
c.Value = Target.Value
Next c
End If
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngCell As Range

If Selection.Count > 1 Then
Set rngBig = Selection
Else
For Each rngCell In rngBig
    rngCell.Value = Application.Max(rngBig)
Next rngCell
End If
End Sub

Just as an aside, I was wondering how important it is that it work for any cell in the selected range because you have to go out of your way to make active a cell other than the top left.
Regards
Harry

Hello again John,
I think this works in all cases.  Couldn't see the wood for the trees /;-{)}

Option Explicit

Dim rngSmall As Range
Dim rngBig As Range


Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Set rngSmall = Target
Application.EnableEvents = False
If Not Intersect(Target, Selection) Is Nothing Then
For Each c In Selection.Cells
c.Value = Target.Value
Next c
End If
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngCell As Range

If Selection.Count > 1 Then
Set rngBig = Selection
Else
For Each rngCell In rngBig
    rngCell.Value = rngSmall.Value
Next rngCell
End If

End Sub

Regards
Harry

Hello Harry,
Firsty, thank you so much for this. One problem with the code at your last post; if a user clicks to another selection without having typed in a new value, rather than the cells in the previous selection staying the same, they take on the value of what was the active cell value (rng.Small I think).

I was thinking that a way round that might be to declare at the emd of the Selection Change macro something like:
Set OldCell = ActiveCell.Value and then at the start of the Selection change macro put in an if statement to compare if the OldCell matches the rngSmall.Value but I'm not sure how to capture the ActiveCell.Value and hold it until it changes.

Hi John,
I think that this covers the possibilities.  I can't think of too many more options to try.  Some of the 'tricks' don't appear to do anything useful but I haven't been able to think of another way to make it work.

Option Explicit
Option Base 1

Dim varArray() As Variant
Dim rngUL As Range
Dim rngSmall As Range
Dim rngBig As Range, rngBigOld As Range


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

ReDim varArray(Selection.Rows.Count, Selection.Columns.Count)
If (Selection.Cells.Count > 1) Then
varArray = Selection.Value
End If
Set rngSmall = Target
Set rngUL = Selection.Cells(1)
Application.EnableEvents = False
If Not Intersect(Target, Selection) Is Nothing Then
    For Each c In Selection.Cells
      c.Value = Target.Value
    Next c
End If
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngCell As Range
Dim lngRows As Long, lngCols As Long
Dim intRows As Integer, intCols As Integer

If rngBigOld Is Nothing Then
    Set rngBigOld = Selection
Else
    Set rngBigOld = rngBig
End If
    Set rngBig = Selection

If Selection.Count > 1 Then
    If Not Not varArray Then
      If (rngBigOld.Count > 1) Then
      For Each rngCell In rngBigOld
        rngCell.Value = rngSmall.Value
      Next rngCell
      End If
      Set rngSmall = Target
      Set rngUL = Selection.Cells(1)
    Else
     Set rngSmall = Target
      Set rngUL = Selection.Cells(1)
    End If
Else
    If (rngBigOld.Count > 1) Then
    For Each rngCell In rngBigOld
      rngCell.Value = rngSmall.Value
    Next rngCell
    End If
End If

End Sub

Let me know how you go.
Regards
Harry

Thanks Harry, that's a lot of effort you've put in there- have given it a try and it's quite tempramental- it does some odd things quite randomly- ranges of cells that I had clicked out of without entering a value suddenly becoming populated when I type a value into the current selection, selecting a contiguous range of cells and they populate with the value in the top left corner of the selection, when moving between cells quickly, the cursor acting as if it's in an infinite loop and then stopping after a few seconds.

I've created extensive help files for the sheet I'm working on, and I'm thinking that I'm ging to leave it up to the user to read them so that they realise that if they click out of a selection rather than using enter, the value will not populate to the other cells that were selected. Any problems because they don't read the help files, I will refer them to it and make it clear that it's not that 'the sheet is not working properly' or 'it's playing up', but that as the user, they are not using the functionality correctly.

Thanks for the feed-back John.  I can't say that I saw any of the symptoms that you describe but maybe it was just the way that I was testing it.  It is a bit difficult not knowing exactly what you are trying to use the application for and the actual layout of the data that you are working with.
Glad to have been of some help and I think the idea of putting some responsibility onto the user is a good one.
Regards
Harry