Probleem met Formule

[vandenhoeckg]

Hallo allemaal

Ik zit met een probleem voor het invullen van mijn factuur.

Ik werk met een barcode scanner om mijn producten in mijn factuur te plaatsen.
Nu ga ik mijn probleem zo goed mogelijk proberen uit te leggen.

In kolom A komt mijn Barcode. nu heb ik dit aangepast in test factuur naar 1,2,3,4
In kolom B komt de product code, kolom F;G product omschrijving, ...

In kolom B; F-G en H staat een formule om de cellen in te vullen.

Bij het scannen van een product wordt deze formule gewist in de cel er onder in kolom B en F-G. In kolom H blijf deze wel staan.

Weet iemand hoe dit komt?

Als het niet duidelijk is, ik heb het factuur bij geplaatst. Zo kan je zelf eens testen.

Bedankt

 

[HSV]

In het blauw zijn de veranderingen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim f As Range, f2 As Range
  If Not Intersect(Target, Range("A19:A56")) Is Nothing And Target.Count = 1 Then
  If Target <> "" Then
  With Application
      .EnableEvents = False
    Set f = Range("a18").Resize(Target.Row - 18).Find(Target, , -4163, 1)
    Set f2 = Blad2.Columns(1).Find(Target, , xlValues, xlWhole)
      If f Is Nothing And f2 Is Nothing Then
         Application.EnableEvents = True
         Exit Sub
      ElseIf Not f Is Nothing Then
[COLOR=#0000ff]          Target.ClearContents[/COLOR]
[COLOR=#0000ff]          Target.Offset(, 8).Resize(, 2).ClearContents[/COLOR]
          f.Offset(, 8) = f.Offset(, 8) + 1
          f.Offset(, 9) = f.Offset(, 7) * f.Offset(, 8)
          .Goto Target
         Application.EnableEvents = True
         Exit Sub
      Else
         Target.Offset(, 8) = Target.Offset(, 8) + 1
         Target.Offset(, 9) = Target.Offset(, 7) * Target.Offset(, 8)
      End If
    .EnableEvents = True
  End With
  End If
 End If
End Sub

 

[vandenhoeckg]

werkt

dank je wel.