Tobias Hungwe
Tobias Hungwe

Reputation: 47

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

Upvotes: 0

Views: 110

Answers (1)

CDP1802
CDP1802

Reputation: 16174

This code is deleting the value

Worksheets("Givenaway").Select
    row = 2
    Do While Cells(row, 1) <> ""
    Range(Cells(row, 1), Cells(row, 3)).Select
    Selection.Delete
Loop

before this line copies it to Databaseinventory

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

It appears to work if you have 3 rows is because on exit from the Do While Cells(x, 1) <> "" loop the value of x will be 3. After deleting the first record then Worksheets("Givenaway").Cells(x, 2).Value will be the value for the third record.

The database update routine also need to be within the loop


Option Explicit

Sub Btn_Clickweggegeven()

    Dim wb As Workbook, rng As Range
    Dim wsInv As Worksheet, wsGiven As Worksheet, wsData As Worksheet
    Dim iRow As Long, iDataRow As Long, iInvRow As Long
    Dim sProduct As String, nValue As Single

    Set wb = ThisWorkbook
    Set wsGiven = wb.Sheets("GivenAway")

    Set wsInv = wb.Sheets("Inventory")

    Set wsData = wb.Sheets("Databaseinventory")
    iDataRow = wsData.Cells(Rows.Count, 1).End(xlUp).row

    iRow = 2
    With wsGiven
        Do While .Cells(iRow, 1) <> ""
            sProduct = .Cells(iRow, 1)
            nValue = .Cells(iRow, 2)

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

            If rng Is Nothing Then
                iInvRow = wsInv.Cells(Rows.Count, 1).End(xlUp).row + 1
                wsInv.Cells(iInvRow, 1).Resize(1, 4).Value = .Cells(iRow, 1).Resize(1, 4).Value
            Else
                iInvRow = rng.row
                wsInv.Cells(iInvRow, 2).Value = wsInv.Cells(iInvRow, 2).Value - nValue
                wsInv.Cells(iInvRow, 4).Value = wsInv.Cells(iInvRow, 4).Value + nValue
            End If

            ' write to database
            iDataRow = iDataRow + 1
            With wsData.Cells(iDataRow, 1)
                .Value = Now
                .NumberFormat = "mm/dd/yyyy hh:mm:ss"
                .Offset(0, 1) = sProduct ' col B
                .Offset(0, 2) = wsInv.Cells(iInvRow, 3).Value + nValue ' col C ??
            End With
            iRow = iRow + 1
        Loop
    End With

    'delete from GivenAway
    wsGiven.Range("A2").Resize(iRow, 3).Delete
    MsgBox iRow - 2 & " records processed", vbInformation

End Sub

Upvotes: 1

Related Questions