Zoeken met VBA in Select case

[danny147]

Beste,

Ik wil verlof kleuren via VBA, maar het aantal uren staan er altijd voor.

VB: 8 VK --> = 8uur VaKantie.

Kan ik onderstaande regel aanpassen zodat hij altijd zoekt naar VK, ook al staat er 4 VK ?

Case "VK": .Interior.ColorIndex = 2

Groetjes Danny. :thumb:

 

[Cobbe]

Zou dit u kunnen verderhelpen?

getal = Right(ActiveCell.Text, 2)
Select Case getal
Case "VK"
With ActiveCell
    .Interior.ColorIndex = 3
    .Font.ColorIndex = 6
Case Else
   .Interior.ColorIndex =0
   .Font.ColorIndex = 0
End With

End Select

 

[danny147]

Beste Cobbe

Ik heb er wel meerdere verlofcodes.

Kan je dit in onderstaande code aanpassen ajb ?

Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim cell_in_loop As Range
    For Each cell_in_loop In Range("D6:AH17")
        With cell_in_loop
            Select Case .Value
                Case "": .Interior.ColorIndex = 2
                Case "VK": .Interior.ColorIndex = 3
                Case "CR": .Interior.ColorIndex = 4
                Case "RS": .Interior.ColorIndex = 5
                Case "EB": .Interior.ColorIndex = 6
                Case "KV": .Interior.ColorIndex = 7
                Case "ZK": .Interior.ColorIndex = 8
            End Select
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Groetjes Danny. :thumb:

 

[Roncancio]

Volgens mij kan je ook zoeken naar de laatste 2 waardes in de cel.

Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim cell_in_loop As Range
    For Each cell_in_loop In Range("D6:AH17")
        With cell_in_loop
            Select Case [COLOR="red"]UCase(Right([/COLOR].Value[COLOR="red"], 2))[/COLOR]
                Case "": .Interior.ColorIndex = 2
                Case "VK": .Interior.ColorIndex = 3
                Case "CR": .Interior.ColorIndex = 4
                Case "RS": .Interior.ColorIndex = 5
                Case "EB": .Interior.ColorIndex = 6
                Case "KV": .Interior.ColorIndex = 7
                Case "ZK": .Interior.ColorIndex = 8
            End Select
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Alleen de rode gedeeltes zijn toegevoegd.
Overigens zou ik ipv van Selection_Change Change gebruiken omdat nu steeds het gehele bereik wordt aangepast.
Dan is de loop ook overbodig.
Dit zou dan volstaan:

Sub Worksheet_Change(ByVal Target As Range)
With Target
    Select Case UCase(Right(.Value, 2))
        Case "": .Interior.ColorIndex = 2
        Case "VK": .Interior.ColorIndex = 3
        Case "CR": .Interior.ColorIndex = 4
        Case "RS": .Interior.ColorIndex = 5
        Case "EB": .Interior.ColorIndex = 6
        Case "KV": .Interior.ColorIndex = 7
        Case "ZK": .Interior.ColorIndex = 8
    End Select
End With

End Sub

Met vriendelijke groet,


Roncancio

 

[danny147]

Beste Roncancio,

Bedankt voor de snelle reactie.

Heb nog een probleempje, nl:
Het verlof wordt ingevuld met formules en ingegeven op een ander tabblad.

Telkens als ik naar het tabblad ga waar het verlof ingevuld wordt, moet ik eerst op een cel klikken om de code te activeren.
Is hier en oplossing voor ?

Groetjes Danny. :thumb:

 

[Roncancio]

Je kunt het Event Activate gebruiken van de betreffende sheet.

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Dim cell_in_loop As Range
    For Each cell_in_loop In Range("D6:AH17")
        With cell_in_loop
            Select Case UCase(Right(.Value, 2))
                Case "": .Interior.ColorIndex = 2
                Case "VK": .Interior.ColorIndex = 3
                Case "CR": .Interior.ColorIndex = 4
                Case "RS": .Interior.ColorIndex = 5
                Case "EB": .Interior.ColorIndex = 6
                Case "KV": .Interior.ColorIndex = 7
                Case "ZK": .Interior.ColorIndex = 8
            End Select
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Met vriendelijke groet,


Roncancio

 

[danny147]

Beste Roncancio,

In tabblad 2 staat een lijst en plaats ik VK bij soort verlof en 8 bij aantal uren.
In tabblad 1 komt dan te staan met formule 8 VK

Als ik van Blad2 naar Blad1 ga moet ik op een cel klikken om de code te activeren.

Heb een bijlage meegestuurd in xlsm in xls was het te groot.

Code staat nu in ThisWorkBook ipv Blad1

Groetjes Danny. :thumb:

 

[Cobbe]

Heb de code op de correcte plaats gezet.
Ik gebruik wel een lus maar het bereik is klein genoeg om geen nadeel te ondervinden.

 

[danny147]

Beste Cobbe,

Bedankt voor het op de juiste plaats te zetten en het aanpassen van de code.

@Roncancio,

Jij eveneens bedankt voor het helpen meezoeken.

Groetjes Danny. :thumb: