Dubbelklikken en dan cellen kleuren

[mulderwme]

Hallo allemaal,

Kinderen moeten afvinken wat ze hebben gedaan.

Als voorbeeld heb ik vervoersmiddelen op verschillende manieren ingedeeld.

Als een kind op bijv. de step in kolom A dubbelklik, komt er een vinkje achter step.
Nu staat step ook in kolom E. Daar wil ik dan op het zelfde moment een vinkje hebben.

Als een kind dubbelklikt op de step in kolom D, dan moet er ook in kolom B een vinkje komen.

En de vinkjes moeten ook weer uitgezet kunnen worden met dubbelklikken.

Het dubbelklikken werkt, maar dan steeds voor één cel.

Later wil ik nog een onderverdeling toevoegen. Maar dan weet ik niet of dat wel gaat werken.

Dan moet ik waarschijnlijk met een tellertje gaan werken als een vervoersmiddel vaker voor komt.

Alvast bedankt!

Groet,
Willem

 

[E v R]

In onderstaande code eea aangepast: (wel leeg beginnen)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Const zoekrange As String = "A6:A13,D6:D8,G6:G6,J6:J9"
    Application.ScreenUpdating = False
    Application.EditDirectlyInCell = False
    Application.EnableEvents = True
    
    On Error Resume Next
    If Not Application.Intersect(Range(zoekrange), _
        Range(Target.Address)) Is Nothing Then
    
        Vinkje Target, zoekrange
      
    End If
    
    Application.ScreenUpdating = True
    
End Sub

Sub Vinkje(cl As Range, zoekbereik As String)

For Each cel In Range(zoekbereik)
If cl.Value = cel.Value Then

    If cel.Offset(0, 1).Interior.Color = 11777023 Then
        cel.Offset(0, 1).Interior.Color = 4829555
        
        cel.Offset(0, 1).Font.Name = "Wingdings"
        cel.Offset(0, 1) = "ü"
        
        With cel.Offset(0, 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        
        With cel.Offset(0, 1).Font
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = -0.499984740745262
            .Bold = True
            .Size = 12
        End With

    Else
        cel.Offset(0, 1).Interior.Color = 11777023
        cel.Offset(0, 1).ClearContents
    
    End If
    End If
Next
        
End Sub

 

[mulderwme]

Dank je wel, Eric,

Dit is een goede oplossing!

mvg
Willem

 

[mulderwme]

Mijn vorige vraag is opgelost. En dan wil je meer

Ik heb de tabellen nu verdeeld over 2 sheets.
Als ik in sheet 1 op een item klik, wil ik dat dat item ook in sheet 2 een kleur krijgt of ervan af gaat.

In de bijlage heb ik weer het bestand gedaan. Daar staat ook in wat ik heb geprobeerd, maar gefaald

Groet,
Willem

 

[E v R]

even snel; de bereiken zijn nu op beide sheets waarin gezocht wordt wel hetzelfde: (in rood de aanpassingen)

Sub Vinkje(cl As Range, zoekbereik As String)
[COLOR="#FF0000"]For i = 1 To 2[/COLOR]
For Each cel In [COLOR="#FF0000"]Worksheets("Ingang " & i).[/COLOR]Range(zoekbereik)
If cl.Value = cel.Value Then

'..... je oude code hier
Next
[COLOR="#FF0000"]Next i[/COLOR]
End Sub

 

[mulderwme]

Dank je, Eric.

Het werkt prima van Ingang 1 naar Ingang 2.
Ik heb nu complete code gekopieerd en achter Ingang 2 geplakt.

Nu werken de vinkjes 2 kanten op.

Ik voeg het bestand nog een keer bij voor iedereen die dit ook leuk vind.

Bedankt!

Willem