# Help with Vba Find to deduct quantities if.

#### Baziwan

##### New Member
 OrderNo Account Name Code Description Quantity 1 22 Ex1 APPLE1 Apples 17 2 38 Ex7 PEAR1 Pears 56 3 41 Ex2 ORANG1 Oranges 180 4 52 Ex8 LEMON1 Lemons 100 5 38 Ex7 PEAR1 Pears 250 6 22 Ex1 APPLE1 Apples 250

<tbody>
</tbody>
 Invoice Account Name Code Description Quantity 1 T1 Tom ORANG1 Oranges 25 2 S1 Simon APPLE1 Apples 25 3 S2 Sally PEAR1 Pears 50 4 D1 Dot LEMON1 Lemons 10 5 K1 Keith APPLE1 Apples 50 6 G1 Gary PEAR1 Pears 25

<tbody>
</tbody>

Hi, I need a little assistance. I have two tables on separate worksheets. Table 1 is purchases (Worksheet("Purchases")) & Table 2 is sales (Worksheet("Sales").

Code:
``````Sub Match1()

Dim rCl As Range
Dim Rw As Long
Dim Amt As Long
Dim sFind As String
Dim ws As Worksheet

Set ws = Worksheets("Purchases")

With Range("Sales") 'THIS IS THE NAMED RANGE OF THE SALES TABLE
For Rw = 1 To .Rows.Count
sFind = .Cells(Rw, 4).Text 'FINDS THE PRODUCT CODE
Amt = .Cells(Rw, 6).Value
On Error Resume Next
With ws.UsedRange.Columns(4)
Set rCl = .Find(sFind, LookIn:=xlValues, lookat:=xlWhole)
If Not rCl Is Nothing Then rCl.Offset(0, 2).Value = rCl.offset(0, 2).value - Amt
End With
Next Rw
End With
End Sub``````

This code deducts the quantity of stock from the purchase when it's sold. But what I need is:- If the quantity of a sale is greater than the quantity in the purchase then it deducts the remaining quantity from the next purchase with that code.
Can anyone help me with this?

### Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

#### MickG

##### MrExcel MVP
Try this:-
NB:- This code will modify Column "F" of sheet "Purchases".
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG29Sep45
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, Temp [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Kk [COLOR="Navy"]As[/COLOR] Variant, Tmp [COLOR="Navy"]As[/COLOR] Double, Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]With[/COLOR] Sheets("Purchases")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("E1", .Range("E" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn.Offset(, 1))
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

[COLOR="Navy"]With[/COLOR] Sheets("Sales")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Else[/COLOR]
Dic(Dn.Value) = Dic(Dn.Value) + Dn.Offset(, 1).Value
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
Tmp = Dic(K)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K)
R.Value = R.Value - Tmp
[COLOR="Navy"]If[/COLOR] R.Value <= 0 [COLOR="Navy"]Then[/COLOR]
Tmp = Abs(R.Value)
R.Value = 0
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Exit[/COLOR] For
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

#### Baziwan

##### New Member
Hi MickG,

Thanks for the response. The end result is exactly what I need, with one issue that I believe is my fault for not giving an example exactly. I need it to find the product by Column D - Code. My example table also didn't show that the descriptions may contain numbers. Eg, Apples 2018. Therefore when I tested the code on the example sheet it performed perfectly but when I changed the description column from
Code:
``[COLOR=#000080]Set[/COLOR] Rng = .Range("E1", .Range("E" & Rows.Count).End(xlUp))``
to the code column
Code:
``[COLOR=#000080]Set[/COLOR] Rng = .Range("D1", .Range("D" & Rows.Count).End(xlUp))``
I get a type mismatch error on this line
Code:
``Tmp = Dic(K)``

#### MickG

##### MrExcel MVP
Could your data contain "Apples 2018" and Apples 2019", etc, in which case I can group the "Apples" cells (column D") using Just the word "Apples" (Split from the number part), or if not I can use the entire string !!!

#### Baziwan

##### New Member

Hi,

The data in column d will always be a combination of letters & numbers & it could vary. Eg APPLE1, APP14BOX, ENGAPP16. But it is the Product codes that will always be the constant between the two tables & so preferable to find the correct product using column d product code.

thanks for your help with this btw.

#### MickG

##### MrExcel MVP
Try this for Column "D" data.
NB:- If the total "Sales" Qty for a particular item is greater than the total "Purchases" Qty for that same item the last value for that item in the "Purchases" sheet will show a negative number .
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG29Sep40
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, Temp [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Kk [COLOR="Navy"]As[/COLOR] Variant, Tmp [COLOR="Navy"]As[/COLOR] Double, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Purchases")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("D1", .Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
.Add Dn.Value, Array(Dn.Offset(, 2).Value, Dn.Offset(, 2), Dn.Offset(, 2))
[COLOR="Navy"]Else[/COLOR]
Q = .Item(Dn.Value)
[COLOR="Navy"]Set[/COLOR] Q(1) = Union(Q(1), Dn.Offset(, 2))
Q(0) = Q(0) + Dn.Offset(, 2).Value
[COLOR="Navy"]Set[/COLOR] Q(2) = Dn.Offset(, 2)
.Item(Dn.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

[COLOR="Navy"]With[/COLOR] Sheets("Sales")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Else[/COLOR]
Dic(Dn.Value) = Dic(Dn.Value) + Dn.Offset(, 2).Value
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
Tmp = Dic(K)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K)(1)
R.Value = R.Value - Tmp
[COLOR="Navy"]If[/COLOR] R.Value <= 0 [COLOR="Navy"]Then[/COLOR]
Tmp = Abs(R.Value)
[COLOR="Navy"]If[/COLOR] Dic(K) > .Item(K)(0) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Else[/COLOR]
R.Value = 0
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Exit[/COLOR] For
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

#### Baziwan

##### New Member

Hi MickG,

sorry for the delayed reply. Thanks so much for this, it works great. Could I trouble you for one other thing.
The two databases that I'm applying this to are quite large & new purchases & sales will be added. Is there a way that it can be run to just calculate for new sales. Example, if on the sales sheet there was a column to the right of quantity that had the date of sale. Then could it be changed to only update sales from the last date the macro was run thus only updating new sales?

Again, thanks for your help & time.

#### MickG

##### MrExcel MVP
Try this:-
The code assumes that there is a previous date in "Sales G1" and against each item in column "G" are dates.
Any dates that are Greater than "G1" will be dealt with by the code, any less than or equal to "G1" will be ignored.
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG01Oct27
'[COLOR="Green"][B]code2[/B][/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, Temp [COLOR="Navy"]As[/COLOR] Double, Dt [COLOR="Navy"]As[/COLOR] Date
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Kk [COLOR="Navy"]As[/COLOR] Variant, Tmp [COLOR="Navy"]As[/COLOR] Double, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Purchases")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("D1", .Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
.Add Dn.Value, Array(Dn.Offset(, 2).Value, Dn.Offset(, 2), Dn.Offset(, 2))
[COLOR="Navy"]Else[/COLOR]
Q = .Item(Dn.Value)
[COLOR="Navy"]Set[/COLOR] Q(1) = Union(Q(1), Dn.Offset(, 2))
Q(0) = Q(0) + Dn.Offset(, 2).Value
[COLOR="Navy"]Set[/COLOR] Q(2) = Dn.Offset(, 2)
.Item(Dn.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

[COLOR="Navy"]With[/COLOR] Sheets("Sales")
Dt = .Range("G1").Value
[COLOR="Navy"]Set[/COLOR] Rng = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 3).Value > Dt [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Else[/COLOR]
Dic(Dn.Value) = Dic(Dn.Value) + Dn.Offset(, 2).Value
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
Tmp = Dic(K)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K)(1)
R.Value = R.Value - Tmp
[COLOR="Navy"]If[/COLOR] R.Value <= 0 [COLOR="Navy"]Then[/COLOR]
Tmp = Abs(R.Value)
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Exit[/COLOR] For
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

#### Baziwan

##### New Member
Thanks for this Mick. Will test it out tomorrow. You've been great.

Replies
4
Views
412
Replies
2
Views
1K
Replies
1
Views
504
Replies
1
Views
416
Replies
5
Views
802

1,130,173
Messages
5,640,588
Members
417,152
Latest member
DayTimeSeby

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back