VBA doet niet helemaal wat ik wil

[AD1957]

Als ik de eerste keer in kolom 4 op blad Begroting het aantal invul werkt de code.
Verander ik echter het aantal dan gaat het fout.
Wie helpt?, kom er maar niet achter waar de fout zit.

Albert
Bekijk bijlage Begroting.xlsb

 

[JeanPaul28]

is dit wat je bedoeld

 

[WoutMag]

Ik weet niet wat Jean-Paul bedacht heeft, maar dit is mijn aanpassing aan de code:

Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
    On Error GoTo Worksheet_Change_Exit
    
    If Target.Row > 12 Then
        Application.EnableEvents = False
        If Target.Column = 1 Then
            Target.Offset(, 1).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 6).Value 'artikelnummer
            Target.Offset(, 2).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 1).Value 'omschrijving
            Target.Offset(, 4).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 2).Value 'bruto prijs per stuk
            Target.Offset(, 8).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 4).Value 'netto prijs per stuk
        ElseIf Target.Column = 4 Then
            Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto
            Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value 'totaal netto
        End If
    End If
Worksheet_Change_Exit:
    Application.EnableEvents = True
End Sub

 

[AD1957]

hallo WoutMAg,
dit probleem is opgelost, hartelijk dank.

Als ik in kolom A de code verwijder wordt niet de hele regel leeggemaakt, heb je daar ook een oplossing voor?
Waarschijnlijk zullen er straks nog meer vragen komen.
ALs voorbeeld alvast, in kolom "totaal loon" moet hetzelfde gebeuren, echter alleen als de code in kolom A 1t/m11 is.

 

[WoutMag]

Je kan dit proberen

Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
    On Error GoTo Worksheet_Change_Exit
    
    If Target.Cells.Count = 1 Then  ' Safety feature, only process when one cell is changed
        If Target.Row > 12 Then
            Application.EnableEvents = False
            If Target.Column = 1 Then
                If IsEmpty(Target) Then
                    Range(Target, Target.Offset(, 9)).ClearContents
                Else
                    Target.Offset(, 1).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 6).Value 'artikelnummer
                    Target.Offset(, 2).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 1).Value 'omschrijving
                    Target.Offset(, 4).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 2).Value 'bruto prijs per stuk
                    Target.Offset(, 8).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 4).Value 'netto prijs per stuk
                End If
            ElseIf Target.Column = 4 Then
                Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value
                Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value
            End If
        End If
    End If
Worksheet_Change_Exit:
    Application.EnableEvents = True
End Sub

Ik hoop dat het helpt.

 

[WoutMag]

En met het loon in de H kolom:

Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
    On Error GoTo Worksheet_Change_Exit
    
    If Target.Cells.Count = 1 Then  ' Safety feature, only process when one cell is changed
        If Target.Row > 12 Then
            Application.EnableEvents = False
            If Target.Column = 1 Then
                If IsEmpty(Target) Then
                    Range(Target, Target.Offset(, 9)).ClearContents
                Else
                    Target.Offset(, 1).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 6).Value 'artikelnummer
                    Target.Offset(, 2).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 1).Value 'omschrijving
                    Target.Offset(, 4).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 2).Value 'bruto prijs per stuk
                    If Target.Value < 12 Then
                        Target.Offset(, 8).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 4).Value 'netto prijs per stuk
                    End If
                End If
            ElseIf Target.Column = 4 Then
                If Target.Offset(, -3).Value < 12 Then
                    Target.Offset(, 4).Value = Target.Value * Target.Offset(, 1).Value
                Else
                    Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value
                    Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value
                End If
            End If
        End If
    End If
Worksheet_Change_Exit:
    Application.EnableEvents = True
End Sub

Succes.

 

[AD1957]

Hoi Wouter,
Volgens mij werkt het nu, moet echter nog alle mogelijkheden in het bestand controleren.
Eerst even eten.
Hou je op de hoogte.

Albert

 

[AD1957]

kleine aanpassing gedaan, zie vette/grote code, verder werkt het super.
Wat ik wel nog vreemd vindt is dat als ik in kolom A 1 cel delete dan wordt inderdaad de hele regel leeggemaakt
Probeer ik dit met een selectie van bijv. A1:A4 dan worden de rijen niet leeggemaakt.

Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
    On Error GoTo Worksheet_Change_Exit
    
    If Target.Cells.Count = 1 Then  ' Safety feature, only process when one cell is changed
        If Target.Row > 12 Then
            Application.EnableEvents = False
            If Target.Column = 1 Then
                If IsEmpty(Target) Then
                    Range(Target, Target.Offset(, 9)).ClearContents
                Else
                    Target.Offset(, 1).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 6).Value 'artikelnummer
                    Target.Offset(, 2).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 1).Value 'omschrijving
                    Target.Offset(, 4).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 2).Value 'bruto prijs per stuk
                   [B][SIZE=5] If Target.Value > 11 Then[/SIZE][/B]
                        Target.Offset(, 8).Value = Sheets("artikellijst").Columns(1).Find(Target.Value).Offset(, 4).Value 'netto prijs per stuk

                    End If
                End If
            ElseIf Target.Column = 4 Then
                If Target.Offset(, -3).Value < 12 Then
                    Target.Offset(, 4).Value = Target.Value * Target.Offset(, 1).Value
                Else
                    Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value
                    Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value
                End If
            End If
        End If
    End If
Worksheet_Change_Exit:
    Application.EnableEvents = True
End Sub

Wouter bedankt voor de moeite, was hier al dagen mee bezig maar kwam er niet uit.

Groet,
Albert