VBA look for match between cell and column then in row add amount to specific cell else copy data in new row

[kaasplank]

Hey all, I am looking for help on a macro. What i want to do:
see if value in B3 matches any value in column d. If it does than add one to specific cell in that row if not copy data in new row.
This is what i have now:
I figures strcomp doesn't work with ranges so tried entering the ranges as strings but this is not working either… Any ideas? (maybe with match or lookup or something else completely?)

Private Sub CommandButton1_Click()
Dim lastrow As Long, Lresult As Integer
With Lresult = StrComp(Range("B3").Text, Range("D2:D65536").Text, vbTextCompare)
If Lresult = 0 Then
lastrow = Range("D65536").End(xlUp).Row
Cells(lastrow, 8).Value = Cells(lastrow, 8) + 1
Else
Range("B3:B6").Copy
lastrow = Range("D65536").End(xlUp).Row
Sheets("Blad1").Activate
Cells(lastrow + 1, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Cells(lastrow + 1, 8).Value = 1
End If
End With

Application.CutCopyMode = False

End Sub

Thanks in advance!

 

[mumps]

Could you use the XL2BB add-in (icon in menu) to post a screen shot of your data? Explain in detail what you want to do referring to specific cells, rows, column and sheets. Replace any confidential data with generic data.

 

[kaasplank]

123124515.xlsm
	A	B	C	D	E	F	G	H
1				artikel nummer	naam	prijs	voorraad	aantal
2		IN0005
3	artiel:	IN0005
4	naam:	Artikel 5
5	prijs	75
6	voorraad	62
7
8
9
10
11
Blad1

In detail:
I have a sheet "voorraadlijst" and blad1. Voorraadlijst contains data of products. On blad1, I can search for product number on b2. Product details are shown below b2. I want a button that adds the product to the range on the right (d1 - h1). If a product matches a product already in the range than i want to "+1" in column h for the specific row in which the match is found. If the product isn't listed yet, copy the data in a new row in the range.

So basicaly what i want is to check for a match between b3 and column D. If there is a match +1 to the row in which the match has been found otherwise copy data in the next empty row.

Does that make sense now?

 

[mumps]

So basicaly what i want is to check for a match between b3 and column D. If there is a match +1 to the row in which the match has been found otherwise copy data in the next empty row.

Using the data you posted, there is no match for IN0005 in column D so B3:B6 should be copied to D2:D5. Is this correct? Let's assume that D2 contained IN0005, then you want to add 1 to whatever value is in H2. Is this correct?

 

[kaasplank]

Using the data you posted, there is no match for IN0005 in column D so B3:B6 should be copied to D2:D5. Is this correct? Let's assume that D2 contained IN0005, then you want to add 1 to whatever value is in H2. Is this correct?

this exactly!

 

[mumps]

Try:

Private Sub CommandButton1_Click()
    Dim lastrow As Long, fnd As Range
    lastrow = Range("B" & Rows.Count).End(xlUp).Row
    Set fnd = Range("D:D").Find(Range("B3").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        Range("H" & fnd.Row) = Range("H" & fnd.Row) + 1
    Else
        Range("B3:B" & lastrow).Copy Cells(Rows.Count, "D").End(xlUp).Offset(1)
    End If
    Application.CutCopyMode = False
End Sub

 

[kaasplank]

123124515.xlsm
	A	B	C	D	E	F	G	H
1				artikel nummer	naam	prijs	voorraad	aantal
2		IN0005		Beschr. 1
3	artiel:	IN0005		51
4	naam:	Artikel 5		1275
5	prijs	75		29
6	voorraad	62		Beschr. 10
7				50
8				8750
9				283
10				Beschr. 10
11				50
12				8750
13				283
Blad1

Cell Formulas
Range	Formula
D2:D13,B3:B6	D2	=INDEX(Voorraadlijst!E3:Voorraadlijst!N27,XMATCH(D1,Voorraadlijst!E3:Voorraadlijst!E27,1),{1;2;4;5})
Dynamic array formulas.

this is the result. Maybe it works if it transposes the copied data?

 

[mumps]

This is what I got when I ran the macro on the data you posted:

kassplant.xlsm
	A	B	C	D	E	F	G	H
1				artikel nummer	naam	prijs	voorraad	aantal
2		IN0005		IN0005
3	artiel:	IN0005		Artikel 5
4	naam:	Artikel 5		75
5	prijs	75		62
6	voorraad	62
Sheet1

 

[kaasplank]

maybe it has something to do with the code under B3?
=INDEX(Voorraadlijst!C4:Voorraadlijst!L28;X.VERGELIJKEN(B2;Voorraadlijst!C4:Voorraadlijst!C28;1);{1;2;4;5})

 

[mumps]

If what I posted is the correct result, try:

Private Sub CommandButton1_Click()
    Dim lastrow As Long, fnd As Range
    lastrow = Range("B" & Rows.Count).End(xlUp).Row
    Set fnd = Range("D:D").Find(Range("B3").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        Range("H" & fnd.Row) = Range("H" & fnd.Row) + 1
    Else
        Range("B3:B" & lastrow).Copy
        Cells(Rows.Count, "D").End(xlUp).Offset(1).PasteSpecial xlPasteValues
    End If
    Application.CutCopyMode = False
    Application.CutCopyMode = False
End Sub