VBA Onupdate niet uitvoeren bij selectie

[wesken]

Beste,

In mijn excel wordt er een update gebeurd voor het nakijken van achtergrondkleuren van bepaalde cellen.
Deze worden in tekst omgezet in hun respectievelijke cellen er naast.
Alles werkt perfect echter heb ik het probleem als er een volledige lijn wordt geselecteerd, gaat hij in alle cellen kleuren beginnen te zetten en loopt de code vast (foutmelding) en als er dan naar foutopsporing wordt gezocht, komt hij bij de 5de regels en verder in het geel.

Iemand idee hoe ik dit kan omzeilen dat de code niet wordt uitgevoerd als er een volledige lijn wordt geselecteerd?
Ik denk dan om de code ergens anders uit te voeren en niet onder OnUpdate?

Private Sub objCommandBars_OnUpdate()
Dim cl As Range
If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub
If ActiveSheet.Name <> rMonitor.Parent.Name Then Exit Sub
If TypeName(Selection) <> "Range" Then Exit Sub
If Intersect(Selection, rMonitor) Is Nothing Then Exit Sub
For Each cl In Selection
cl.Offset(, 1).Value = IIf(cl.Interior.Color = RGB(255, 0, 0), "Rood", _
IIf(cl.Interior.Color = RGB(0, 176, 80), "Groen", _
IIf(cl.Interior.Color = RGB(255, 192, 0), "Oranje", _
IIf(cl.Interior.Color = RGB(0, 176, 240), "Blauw", _
IIf(cl.Interior.Color = RGB(255, 255, 0), "Geel", "Wit")))))

Next cl
End Sub

Alvast dank voor de hulp

 

[OctaFish]

Je gaat natuurlijk altijd in de problemen komen met deze constructie, omdat je één cel teveel opmaakt (aantal cellen in de range +1). Bij een volledige rij is die extra cel er niet. Tel dus eerst het aantal cellen en baseer daar je actie op.

        If Selection.Cells.Count > 10 Then MsgBox "Je hebt teveel cellen geselecteerd."

 

[OctaFish]

En zo kun je het voor je selectie oplossen denk ik:

Dim cl As Range, i As Integer
    For Each cl In Selection
        i = i + 1
        If i = Selection.Cells.Count Then Exit Sub
        cl.Offset(, 1).Value = IIf(cl.Interior.Color = RGB(255, 0, 0), "Rood", _
            IIf(cl.Interior.Color = RGB(0, 176, 80), "Groen", _
            IIf(cl.Interior.Color = RGB(255, 192, 0), "Oranje", _
            IIf(cl.Interior.Color = RGB(0, 176, 240), "Blauw", _
            IIf(cl.Interior.Color = RGB(255, 255, 0), "Geel", "Wit")))))
    Next cl

 

[wesken]

Bedankt Octafish,

Echter is dit geen oplossing doordat hij blijft verderwerken in de loop en steeds de melding geeft dat er te veel cellen zijn en zet hij toch kleurne in alle cellen die geselecteerd zijn en ben ik de gegevens kwijt.

 

[edmoor]

Plaats dan een voorbeeld document waarin het probleem zichtbaar is.

 

[Ginger]

Gebruik SpecialCells om alleen over de gevulde cellen in de selectie te lopen...

 

[wesken]

Goedemorgen,

Gisteren helaas nog te druk gehad maar vandaag er terug tegenaan

In bijlage een vereenvoudig voorbeeld van mijn excel met de VBA code als commentaar gezet zodat deze geen foutmeldingen of bugs weergeeft.
Mooi , juist en proper is het niet naar code gezien maar is ook al zeker meer dan 10 jaar geleden dat ik dit nog heb gebruikt maar met nieuwe job zal ik er terug dagelijks met bezig zijn (joepie!) dus komt alles wel terug hopelijk, ben al blij dat ik dit terug heb kunnen realiseren ondanks de niet juiste manier van programmatie.

Alvast dank voor jullie hulp allemaal.

I.v.m. SpecialCells denk ik het niet te kunnen oplossen, lijkt me toch complexer.

 

[cow18]

geen idee wat rMonitor is, zo te zien geen gedefinieerde naam, maar anders ?

Set isect = Intersect(Selection, rMonitor)
If Not isect Is Nothing Then Exit Sub
For Each cl In isect.Cells

 

[wesken]

Dank je Cow18,

Als ik lijn selecteer dan gebeurd er niets meer zoals het hoort en kan ik nieuwe lijnen toevoegen.

Echter loop ik nu tegen wel iets zeer basis aan (basis terug opfrissen hier dus na 10 jaar)
ik heb isect gedefinieerd als String maar als ik nu in TABBLAD MASTER een knop gebruik om een selectie uit te voeren, loopt hij vast op COMPILEERFOUT met melding object vereis op dus ISECT....
Set isect = Intersect(Selection, rMonitor)

 

[wesken]

Allen,

Ik heb het simpel opgelost met toevoeging van 2 kolommen en onderstaande link:

https://www.templatebuilding.com/index.php/excelleren/wetenswaardigentipstrucs/9353-wwcellezen