Target range te lang, hoe kan ik dit simpeler maken?

[kaan]

Hoi Allen,

Ik zit met de probleem dat mijn target range te lang is!
Ik heb op internet zitten zoeken voor een oplossing hiervoor maar helaas geen oplossing voor kunnen vinden.

Wie kan mij helpen met een formule om de target range te kunnen versimpelen?

Target range begint bij rij B9 en loopt met 5 punten per keer op B9,B14,B19 en zo voort!

Al vorens veel dank hier voor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("L7:L405,P7:P405,T7:T405,Y7:Y405")) Is Nothing Or _
Target.Count > 1 Then Exit Sub
With Target.Offset(, -1)
.Formula = Now
.NumberFormat = "HH:MM"
End With


    If Not Intersect(Target, Range("L7:L405,P7:P405,T7:T405")) Is Nothing Then
        Target.Offset(, -2).Value = "OK"
        Target.Offset(, -2).Interior.ColorIndex = 4
        Target.Offset(, -2).Font.Name = "Arial"
        Target.Offset(, -2).Font.Size = 8
    End If
    
    If Not Intersect(Target, Range("B9,B14,B19,B24,B29,B34,B39,B44,B49,B54,B59,B64,B69,B74,B79,B84,B89,B94,B99,B104,B109,B114,B119,B124,B129,B134,B139,B144,B149,B154,B159,B164,B169,B174,B179,B184")) Is Nothing Then
  Target.Interior.ColorIndex = IIf(Target.Value > 0, 6, xlNone)
End If
End Sub

 

[HSV]

Ik loop niet je hele code bij langs, maar zo zou het kunnen.

 If Target.Column = 2 And Target.Row > 8 And Target.Row < 185 And Target.Row Mod 5 = 4 Then
    Target.Interior.ColorIndex = IIf(Target.Value > 0, 6, xlNone)
End If

 

[kaan]

Goedenavond Harry,

Ik zie dat ik maar de helft van de nodige code heb toegevoegd die nodig om het werkend te krijgen.

Kun je even kijken naar de voorbeeld file als je daar tijd voor heb?

Ik zit zelf ook te puzzelen maar het lukt mij niet helemaal.

Bekijk bijlage regfile2.xlsm

 

[Warme bakkertje]

De Intersect-methode heeft net als Union een beperking van 30 argumenten.

 

[sylvester-ponte]

Kaan, dat idee van Harry in post2 kun je naar je eigenwensen aanpassen.

 

[Cobbe]

Geef dat bereik een naam en gebruik die in je bewerkingen.

 

[kaan]

Allen,

Ik heb nu 2 dagen zitten sleutelen maar helaas is het mij niet gelukt om de code van HJarry te integreren in mijn code!

Wie wil een voorbeeld voor mij posten?

 

[kaan]

Allen,

Ik heb nu 2 dagen zitten sleutelen maar helaas is het mij niet gelukt om de code van Harry te integreren in mijn code!

Wie wil een voorbeeld voor mij posten?

 

[Warme bakkertje]

Als oplossing van je probleem in kolom B volg je best de raad van Cobbe.
Het grotere probleem in je code is de 1ste regel. Deze zorgt er namelijk voor dat wanneer je doelcel zich niet in kolom L, P, T of Y bevindt de code verlaten wordt.

 

[kaan]

Sorry heren,

Door de drukte heb ik geen tijd om te gaan programmeren.

Vergeef het mij maar ik snap niet helemaal wat jullie bedoelen!

Wel heb ik de volgende geprobeerd zonder resultaat.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("L7:L405,P7:P405,T7:T405,Y7:Y405")) Is Nothing Or _
Target.Count > 1 Then Exit Sub
With Target.Offset(, -1)
.Formula = Now
.NumberFormat = "HH:MM"
End With


    If Not Intersect(Target, Range("L7:L405,P7:P405,T7:T405")) Is Nothing Then
        Target.Offset(, -2).Value = "Gate"
        Target.Offset(, -2).Interior.ColorIndex = 4
        Target.Offset(, -2).Font.Name = "Arial"
        Target.Offset(, -2).Font.Size = 8
    End If

 If Target.Column = 2 And Target.Row > 8 And Target.Row < 185 And Target.Row Mod 5 = 4 Then
    Target.Interior.ColorIndex = IIf(Target.Value > 0, 6, xlNone)
End If

End Sub

 

[HSV]

Test het zo eens.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 And Target.Row > 8 And Target.Row < 185 And Target.Row Mod 5 = 4 Then
    Target.Interior.ColorIndex = IIf(Target.Value > 0, 6, xlNone)
ElseIf Intersect(Target, Range("L7:L405,P7:P405,T7:T405,Y7:Y405")) Is Nothing Or Target.Count > 1 Then
   Application.EnableEvents = True
   Exit Sub
Else
   Target.Offset(, -1) = Format(Now, "HH:MM")
    End If
    If Not Intersect(Target, Range("L7:L405,P7:P405,T7:T405")) Is Nothing Then
        Target.Offset(, -2).Value = "Gate"
        Target.Offset(, -2).Interior.ColorIndex = 4
        Target.Offset(, -2).Font.Name = "Arial"
        Target.Offset(, -2).Font.Size = 8
    End If
  Application.EnableEvents = True
End Sub

 

[kaan]

Hoi Harry,

Ik heb het wel toegevoegd maar op ene of andere manier wil het niet meewerken.

Zie de bijlagen!

Het gaat er om als ik op H9 of H14 enz. dubbelklik zal het mooie zijn als de cel dan van kleur gaat veranderen.

 

[HSV]

Hoi kaan,

Test het bestandje eens.

 

[kaan]

Harry en de rest,

heel veel dank voor jullie hulp, ik denk dat ik het hiermee ga redden.