Macro af- c.q. bijboeken

[Hans1957]

Beste lezers,
Ik heb een probleem met een macro binnen excel 2016 en wat ik ook zoek en na lees, ik kom er niet uit. Het betreft een macro om bij te boeken. In een cel staat een waarde en de macro moet de opgegeven waarde in de betreffende cel optellen. So far so good, echter springt hij na de berekening naar de naastgelegen cel (die een andere waarde heeft) Deze waarde wordt dan verwijderd wat niet de bedoeling is. Wie kan mij verder helpen. Hieronder de macro:
Sub afboeken()
TestValue = InputBox("Geef het artikelnummer: ", "Zoeken maar")
Set FoundCell = ActiveSheet.Range("A4:A500").Find(TestValue)
If FoundCell Is Nothing Then
MsgBox "Het artikel is niet gevonden"
Else
Range(FoundCell.Address).Offset(, 5).Select
ActiveCell = InputBox("Hoeveelheid")
ActiveCell.Offset(, -1).Value = ActiveCell.Offset(, -1).Value + ActiveCell.Value
ActiveCell.ClearContents
End If
End Sub

Wie heeft de oplossing?
Groeten,
Hans

 

[edmoor]

Ik denk je teveel doet. Doe het eens zo (Controleer wel even de offset wegens geen voorbeeld):

    Waarde = InputBox("Geef het artikelnummer: ", "Zoeken maar")
    Set FoundCell = ActiveSheet.Range("A4:A500").Find(Waarde)
    If FoundCell Is Nothing Then
        MsgBox "Het artikel is niet gevonden"
        Exit Sub
    End If
        
    Waarde = InputBox("Hoeveelheid")
    ActiveCell.Offset(, -4).Value = ActiveCell.Offset(, -4).Value + Waarde

 

[Hans1957]

Het voorbeeld ziet er als volgt uit:
Artikelnummer Artikelsoort Begin voorraad Bijgeboekt Afgeboekt Totaal in voorraad
1 Riemen 50 20 10 60
2 voerbak 5 5 2 8

De eerste oplossing zou kunnen werken maar dan lukt het mij niet om de offset goed te krijgen. De oplossing van Sjon R geeft rare foutmeldingen. EdMoor zou jij aan de hand van dit voorbeeld de offset goed kunnen krijgen. Als ik bijv. 2 riemen wil afboeken van de voorraad moet hij in kolom Afgeboekt(5) er 2 bij optellen.

dank alvast voor de snelle reacties.

 

[edmoor]

Met een voorbeeld wordt een Excel document bedoeld.

 

[Hans1957]

Als het goed is zit de bijlage er nu bij

 

[edmoor]

Probeer dit dan maar eens:

Sub afboeken()
    Waarde = InputBox("Geef het artikelnummer: ", "Zoeken maar")
    Set foundcell = ActiveSheet.Range("A2:A500").Find(Waarde)
    If foundcell Is Nothing Then
        MsgBox "Het artikel is niet gevonden"
        Exit Sub
    End If
        
    Waarde = InputBox("Hoeveelheid")
    Cells(foundcell.Row, 5).Value = Cells(foundcell.Row, 5).Value + Waarde
End Sub

 

[Hans1957]

Opgelost

Super bedankt alles werkt zonder fouten!
gr
hans

 

[edmoor]

Graag gedaan

 

[Cobbe]

Bij- en Afboeken ingevoegd.

 

[edmoor]

@Cobbe:

Sub afboeken()
    Boeken (4)
End Sub

Sub bijboeken()
    Boeken (3)
 End Sub

Sub Boeken(AfBij As Integer)
    Artnr = InputBox("Geef het artikelnummer: ", "Zoeken maar")
    Set FoundCell = ActiveSheet.Range("A:A").Find(Artnr)
    If FoundCell Is Nothing Then
        MsgBox "Het artikel is niet gevonden"
        Exit Sub
    End If
    FoundCell.Offset(, AfBij).Select
    Aantal = InputBox("Hoeveelheid")
    ActiveCell.Value = ActiveCell.Value + Aantal
End Sub

 

[VenA]

Om wat chaos in het bestand te voorkomen

Sub Boeken(AfBij As Integer)
  Dim r As Range
    Set r = ActiveSheet.Range("A:A").Find(InputBox("Geef het artikelnummer: ", "Zoeken maar"))
    If r Is Nothing Or r = "" Then
        MsgBox "Het artikel is niet gevonden"
        Exit Sub
    End If
    r.Offset(, AfBij) = Application.InputBox("Hoeveelheid", , , , , , , 1)
End Sub

 

[edmoor]

TS kan alle kanten op