via vinkje en VBA kolom vullen/legen

[popipipo]

In Rij 2 zet ik via dubbel klikken en 'vinkje' of een 'kruisje'
Als er een kruisje staat moet in diverse cellen van die kolom 'minnetjes' komen te staan
Voor elke kolom geldt hetzelfde.
Hoe moet de de VBA zo aanpassen dat ik dit niet voor elke kolom moet definiëren.

 

[Niels28]

Voor alle kolommen.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Union(Range("a2:D2"), Range("f2"), Range("H2: J2"))) Is Nothing Then
   
    If Target = Chr(253) Then
    Target.Offset(1, 0).Resize(2, 1) = "-"
    Target.Offset(5, 0).Resize(2, 1) = "-"
    Target.Offset(10, 0) = "-"
    Target.Offset(14, 0).Resize(4, 1) = "-"
    Target.Offset(21, 0).Resize(5, 1) = "-"
    Target.Offset(27, 0).Resize(5, 1) = "-"
    Target.Offset(33, 0).Resize(5, 1) = "-"
     Target.Offset(39, 0).Resize(5, 1) = "-"
    Else
   
    'minnetjes in kolom  verwijderen
    If Target = Chr(254) Then
    Target.Offset(1, 0).Resize(2, 1) = ""
    Target.Offset(5, 0).Resize(2, 1) = ""
    Target.Offset(10, 0) = ""
    Target.Offset(14, 0).Resize(4, 1) = ""
    Target.Offset(21, 0).Resize(5, 1) = ""
    Target.Offset(27, 0).Resize(5, 1) = ""
    Target.Offset(33, 0).Resize(5, 1) = ""
     Target.Offset(39, 0).Resize(5, 1) = ""
End If
End If
End If
End Sub

Niels

 

[Niels28]

Ik zou het geheel onder dubbel klik zetten.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("a2:z2")) Is Nothing Then

If Target.Value = Chr(253) Then
           With ActiveCell
            .Value = Chr(254)
            .Font.Color = 5296274
           End With
               Target.Offset(, 1).Select
              Else
       
         
       With Target
        ActiveCell.Value = Chr(253)
          .Font.Color = 255
            ' .Font.Size = 10
            ' .Font.Bold = False
        End With

        Target.Offset(, 1).Select
End If
End If

    If Not Intersect(Target, Union(Range("a2:D2"), Range("f2"), Range("H2: J2"))) Is Nothing Then
   
    If Target = Chr(254) Then
    Target.Offset(1, 0).Resize(2, 1) = "-"
    Target.Offset(5, 0).Resize(2, 1) = "-"
    Target.Offset(10, 0) = "-"
    Target.Offset(14, 0).Resize(4, 1) = "-"
    Target.Offset(21, 0).Resize(5, 1) = "-"
    Target.Offset(27, 0).Resize(5, 1) = "-"
    Target.Offset(33, 0).Resize(5, 1) = "-"
     Target.Offset(39, 0).Resize(5, 1) = "-"
    Else
   
    'minnetjes in kolom A verwijderen
    If Target = Chr(253) Then
    Target.Offset(1, 0).Resize(2, 1) = ""
    Target.Offset(5, 0).Resize(2, 1) = ""
    Target.Offset(10, 0) = ""
    Target.Offset(14, 0).Resize(4, 1) = ""
    Target.Offset(21, 0).Resize(5, 1) = ""
    Target.Offset(27, 0).Resize(5, 1) = ""
    Target.Offset(33, 0).Resize(5, 1) = ""
     Target.Offset(39, 0).Resize(5, 1) = ""
End If
End If
End If
End Sub

Niels

 

[popipipo]

Het geheel onder dubbel klikken gezet.
En Chr(253) even omgedraaid met Chr(254)
En het loopt op rolletjes. :thumb: :thumb: