Randomly select Target cells without being able to target a same cell twice

Question

I tried multiples things and I'm still not able to resolve my problem.

What could I add to the code in order to not be able to Target a same value in Range("A5:G11") twice, and only be able to Target a maximum of 6 values in Range("A5:G11") at the time?

Here is what I have up to now.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim valeur As Range, c As Range, KeyRange As Range

If Target.Cells.Count > 1 Then
    Exit Sub

        ElseIf Not (Intersect(Target, Range("A5:G11")) Is Nothing) Then
            Target.Interior.ColorIndex = 3
        Else

    Exit Sub
End If

Set valeur = Range("C14:C19")

For Each c In valeur.Cells
    If c.value = "" Then
        c.value = Target.value
            Exit Sub
    End If
Next c

On Error Resume Next

Set KeyRange = Range("C14")
valeur.Sort Key1:=KeyRange, Order1:=xlAscending

End Sub

What could I add in order to not be able to Target a same value in Range("A5:G11") twice, and only be able to Target a maximum of 6 values at the time? — Erika Bouchard, Mar 14 '15 at 21:10

hpf · Answer 1 · 2015-03-14T16:12:44.033

You've got a good start. We can clean up your code a bit by using the "ElseIf" statement rather than nesting If's inside other If's. Then, to deal with the pasting issue, we'll use a For Each loop.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim valeur As Range, C as Range


If Target.Cells.Count > 1 Then
    Exit Sub
ElseIf Not (Intersect(Target, Range("A5:G11")) Is Nothing) Then
    Target.Interior.ColorIndex = 3
Else
    Exit Sub  'No need for the last if statement
End If

set valuer=range("C14:C16")
For each C in valuer.cells
    if c.value="" then
        c.value=Target.value
        exit sub
    end if
Next c

'If get to this step, then the C14:C16 range is full, can put some error handling, reset, etc.

End Sub

You could also do that last bit with a FOR NEXT loop, by using:

For R=14 to 16 'should DIM R as Integer at the top
    if Cells(r,3)="" then
        Cells(r,3).value=Target.value
        exit sub
    end if
Next R

EDIT: The question was edited so that the pasted results should start at C14 and then just keep growing.

In that case:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim R as Integer


If Target.Cells.Count > 1 Then
    Exit Sub
ElseIf Not (Intersect(Target, Range("A5:G11")) Is Nothing) Then
    Target.Interior.ColorIndex = 3
Else
    Exit Sub  'No need for the last if statement
End If

R=14
Do While Cells(R,3)<>""
    R=R+1
Loop
Cells(R,3)=Target.value

End Sub

What could I add in order to not be able to Target a same value in Range("A5:G11") twice, and only be able to Target a maximum of 6 values at the time? — Erika Bouchard, Mar 14 '15 at 21:09
In the code you included, you already change the colorindex of the cell to "3". To prevent the same cell being selected twice, just add: ElseIf Not (Intersect(Target, Range("A5:G11")) Is Nothing) **and Target.interior.colorindex<>3** Then. To only target a maximum of 6 cells, you could go back to the first solution (using the valuer range), set that range for 6 cells (C14:C19), and then where I had the comment about error handling, add whatever you want to do if all spots are full. — hpf, Mar 15 '15 at 16:38

El Scripto · Answer 2 · 2015-03-14T13:35:41.857

Try this:

**You need to first select the cells while holding the Ctrl keyboard key and then run this method.

  Sub DoCopyBySelectionOrder()
    Const MAX_SELECTION As Integer = 6

    Dim oFirstTargetCell As Range
    Dim oTmpCell As Range
    Dim oCell As Range
    Dim sSrcRange As String
    ' r- for rows, c- for columns
    Dim r%
    Dim iCount As Integer

    r = 0
    iCount = 0

    sSrcRange = "A5:G11"

    Set oFirstTargetCell = ActiveSheet.Range("A14")

    For Each oCell In Selection
        If IsEmpty(oCell) = False Then
            If oCell.Text <> "" Then
                If Not (Intersect( _
                        oCell, ActiveSheet.Range(sSrcRange)) Is Nothing) Then
                    ' In the first pass the cell returned will be A14 because
                    ' r is 0 at that point.
                    Set oTmpCell = oFirstTargetCell.Offset(r, 0)
                    oTmpCell.Value = oCell.Value

                    iCount = iCount + 1
                    ' EXIT
                    If iCount >= MAX_SELECTION Then Exit Sub

                    r = r + 1
                End If
            End If
        End If
    Next

End Sub

What could I add in order to not be able to Target a same value in Range("A5:G11") twice, and only be able to Target a maximum of 6 values at the time? — Erika Bouchard, Mar 14 '15 at 21:09
You can change the MAX_SELECTION value to whatever max you like. I do not think it is possible to select the same value twice. I believe either something is selected or not. — El Scripto, Mar 15 '15 at 07:17

Randomly select Target cells without being able to target a same cell twice

2 Answers2