Reputation: 47
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
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 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
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