2 Voorkeuren middels dubbelklik

[Fredemel]

Wie kan me helpen (zie de bijlage)
Wellicht te lang aan het turen/zoeken/alternatieve proberen etc....

Er dienen maximaal 2 voorkeuren aangegeven te worden.
Voorkeur 1 en/of voorkeur 2
Als alle cellen leeg zijn moet er na de dubbelklik een 1 komen
Als er in het bereik een 1 of een 2 staat moet de dubbelklik een 2 of een 1 genereren
Als ze op een reeds ingevulde cel dubbelklikken moet ie leeg worden.
Als ze al een voorkeur 1 én 2 gedaan hebben moet er een MsgBox komen als ze tóch op een lege cel dubbelklikken met als resultaat "".

 

[HSV]

Test het zo eens.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim total As Integer
    Dim myRange As Range
    Set myRange = Range("$B$2,$B$5,$B$8,$B$11,$B$14,$B$17")
    
   Application.ScreenUpdating = False
    
    If Not Intersect(Target, myRange) Is Nothing Then
     With Target
        If .Value = 1 Or .Value = 2 Then
          .Value = ""
        ElseIf .Value = "" And Range("total").Value = 0 Then
           .Value = 1
        ElseIf .Value = "" And Range("total").Value = 1 Then
          .Value = 2
        ElseIf .Value = "" And Range("total").Value = 2 Then
          .Value = 1
        ElseIf .Value = "" And Range("total").Value = 3 Then
          .Value = ""
MsgBox "U heeft al 2 kuzes gemaakt, dubbelklik éérst op een reeds ingevoerde 1 of 2.", , "Maximaal 2 keuzes maken...!"
        End If
        Application.Goto .Offset(3, 0)
      End With
    End If
  Application.ScreenUpdating = True
End Sub

 

[Fredemel]

Thanx

als je te lang gefixeerd bent, zie je de "makkelijke" oplossing niet meer....
Harrie, BEDANKT....!