Verticaal zoeken in vba

Status
Niet open voor verdere reacties.
R

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
947
Beste Helpmij'ers,

Ik heb een code in vba die verticaal zoekt (zie onderstaande code)

Code: 
                If Target.Column = 4 Then
                    Target.Offset(, 9).Value = Sheets("Persoonlijke instelling").Columns(4).Find(Target.Value).Offset(, 9).Value
                End If

Hij werkt echter niet wanneer in kolom 4 (target) een verwijzing staat, die automatisch gevuld wordt. Ik moet dus echt een waarde vanuit kolom 4 aanklikken anders wordt de code niet geactiveerd. Wie kan mij hierbij helpen?

Alvast erg bedankt.

Robert
 
Gebruik een ander event dan de change_event.
 
Er zijn meer events dan alleen de change_event.
 
Plaats altijd de volledige regel Sub of Private Sub erbij, dan is ook te zien welk event wordt gebruikt.
 
Mijn verontschuldiging voor mijn onvolledigheid, ik ben nog te veel onkundig.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

Dit is de event van het betreffende werkblad. Ik hoop hiermee voldoende volledig te zijn. Moet False misschien op True gezet worden?
 
In die regel is het rode gedeelte het event (gebeurtenis):
Private Sub Worksheet_Change(ByVal Target As Range)

Bij het verlaten van de een Sub dient in ieder geval die Application.EnableEvents weer op True te worden gezet.
Plaats even de hele Private Sub. Dan kan het beste worden beoordeeld wat er eventueel moet veranderen.
 
Hierbij doe ik jou de volledige code toekomen:

Code: 
'R I T  E N  U R E N R E G I S T R A T I E

Private Sub Worksheet_Change(ByVal Target As Range)
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'    Static VorigeRegel As Long

Application.DisplayFullScreen = False 'zet op True om te activeren
ActiveWindow.DisplayWorkbookTabs = True 'Laat de werkbladen verdwijnen (False)

Application.EnableEvents = False

If Not Intersect(Target, Range("a4:z500")) Is Nothing Then
    If Selection.Count = 1 Then
        If Not Intersect(Target, Union(Columns(1), Columns(2), Columns(3), Columns(4), Columns(5), Columns(6), Columns(7), Columns(8), Columns(9), Columns(10), Columns(11), Columns(12), Columns(13), Columns(14), Columns(15), Columns(16), Columns(17), Columns(18), Columns(19), Columns(20), Columns(21), Columns(22), Columns(23), Columns(32))) Is Nothing Then
            With Target

            If .Column = 1 And Not IsEmpty(Target) Then Application.Goto .Offset(, 4) 'kolom a
            If .Column = 5 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom e
            If .Column = 6 And Not IsEmpty(Target) Then Application.Goto .Offset(, 6) 'kolom f
            If .Column = 7 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom g
            If .Column = 8 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom h
            If .Column = 9 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom i
            If .Column = 9 And Not IsEmpty(Target) Then Application.Goto .Offset(, 2) 'kolom j
            'If .Column = 10 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom k
            
            If .Column = 12 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom l
            If .Column = 13 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom m
            If .Column = 14 And Not IsEmpty(Target) Then Application.Goto .Offset(, 3) 'kolom n
            If .Column = 15 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom o
            If .Column = 16 And Not IsEmpty(Target) Then Application.Goto .Offset(1, -16) 'kolom P
            If .Column = 17 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom r20
            If .Column = 18 And Not IsEmpty(Target) Then Application.Goto .Offset(1, -17) 'kolom R
    
            'Hoofdletters
            For Each cl In Range("F3:K500").SpecialCells(xlCellTypeConstants, 2)
            cl.Value = UCase(Left(cl.Value, 1)) & Right(cl.Value, Len(cl.Value) - 1)
            Next
            [F3:F500] = [index(lower(F3:F500),)] 'proper = hoofdletters alle woorden

 
            If Range("l" & Target.Row) <> "" And Range("m" & Target.Row) = "" Then
                If Target.Column = 4 Then
                    Target.Offset(, 9).Value = Sheets("Persoonlijke instelling").Columns(4).Find(Target.Value).Offset(, 9).Value
                End If
            End If
             

        End With
    End If
End If
End If
Application.EnableEvents = True
end sub

End Sub
 
Hierbij een voorbeeldbestand.

Wanneer je deze opent en een naam vult in kolom E (Klant) moet deze in kolom M de kilometerstand uit sheet "Persoonlijke instelling" halen. Dit werkt zoals gezegd niet automatisch maar pas wanneer je in kolom D "Voertuig" het kenteken nog een keer activeert. Graag zou ik dat dit automatisch willen hebben.

Bekijk bijlage Ritadministratie test.xlsm
 
De oplossing is eenvoudig
Code: 
If Range("e" & Target.Row) <> "" And Range("C" & Target.Row) = "" Then
   Target.Offset(, 9).Value = Sheets("Persoonlijke instelling").Columns(4).Find(Target.Value).Offset(, 9).Value

Mag je zelf even uitvlooien waar je het neer moet zetten.

Breng structuur aan in de code zoals ik heb laten zien in in jouw andere vraag dmv Select Case. Het flippert nu alle kanten op waardoor ik er weinig van begrijp hoe je de invoer geregeld wil hebben.
 
Sorry voor mijn late reactie, dit is mij helemaal ontschoten. Maar alsnog heel erg bedankt voor jouw hulp, ik ben hier ontzettend mee geholpen...
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan