(Solved) – VBA value range doing strange

(solved)-–-vba-value-range-doing-strange

So how do i put this i am a vba rookie and i have been trying to make an excel file and the purpose is that it should be an inventory of all items one sheet is for putting items in and other is for giving them away. But that is not the problem, the thing is i wanted to have a page called “databaseinventory” where all products that are taken out are writen down but my value is doing strange. (look at the image)

So this is the input screen and if i type this
So this is the input screen and if i type this

this is the output on a different sheet but i don’t want it to be 0
this is the output on a different sheet but i don't want it to be 0
I noticed if i change the input and add 3 rows it works but that prevents me of typing more then one product
I noticed if i change the input and add 3 rows it works but that prevents me of typing more then one product
this is the output that i want to have and i really don’t know what is wrong with the code
this is the output that i want to have and i really don't know what is wrong with the code

    Sub Btn_Clickweggegeven()

Dim x As Long
Dim Givenaway As Worksheet
Dim Inventory As Worksheet
Dim productn As String
Dim erow As Long
Dim rng As Range
Dim rownumber As Long
Dim row As Long

Dim wsData As Worksheet
Dim wsIn As Worksheet
Dim nextRow As Long

Dim BtnText As String
Dim BtnNum As Long
Dim strName As String

x = 2
Do While Cells(x, 1) <> ""

' go through each item on list
    productn = Cells(x, 1)

' if item is not new then add quanity to total Inventory
   With Worksheets("Inventory").Range("A:A")
            Set rng = .Find(What:=productn, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)


'if item is new add item to the bottom of Inventory list


            If rng Is Nothing Then
                erow = Worksheets("Inventory").Cells(1, 1).CurrentRegion.Rows.Count   1
                Worksheets("Inventory").Cells(erow, 1) = Worksheets("Givenaway").Cells(x, 1)
                Worksheets("Inventory").Cells(erow, 2) = Worksheets("Givenaway").Cells(x, 2)
                Worksheets("Inventory").Cells(erow, 3) = Worksheets("Givenaway").Cells(x, 3)
                Worksheets("Inventory").Cells(erow, 4) = Worksheets("Givenaway").Cells(x, 4)
                 GoTo ende
             Else
                rownumber = rng.row

             End If
        End With

        Worksheets("Inventory").Cells(rownumber, 2).Value = Worksheets("Inventory").Cells(rownumber, 2).Value _
        - Worksheets("Givenaway").Cells(x, 2).Value

        Worksheets("Inventory").Cells(rownumber, 4).Value = Worksheets("Inventory").Cells(rownumber, 4).Value _
          Worksheets("Givenaway").Cells(x, 2).Value
ende:
        x = x   1

        Loop

'after complete delete items from Givenaway list
Worksheets("Givenaway").Select
    row = 2
    Do While Cells(row, 1) <> ""
    Range(Cells(row, 1), Cells(row, 3)).Select
    Selection.Delete
Loop





    Set wsIn = Worksheets("Givenaway")
Set wsData = Worksheets("Databaseinventory")

With wsData
  nextRow = .Cells(.Rows.Count, "A") _
    .End(xlUp).Offset(1, 0).row
End With




With wsData
  With .Cells(nextRow, 1)
    .Value = Now
    .NumberFormat = "mm/dd/yyyy hh:mm:ss"
  End With
  .Cells(nextRow, 2).Value = productn

  .Cells(nextRow, 3).Value = Worksheets("Databaseinventory").Cells(rownumber, 3).Value _
          Worksheets("Givenaway").Cells(x, 2).Value


End With

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *