Help with Vba Find to deduct quantities if.

B

Baziwan

New Member
Joined
Sep 4, 2018
Messages
32
[TABLE="class: outer_border, width: 50, align: left"]
<tbody>[TR]
[TD]OrderNo
[/TD]
[TD]Account
[/TD]
[TD]Name
[/TD]
[TD]Code
[/TD]
[TD]Description
[/TD]
[TD]Quantity
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]22
[/TD]
[TD]Ex1
[/TD]
[TD]APPLE1
[/TD]
[TD]Apples
[/TD]
[TD]17
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]38
[/TD]
[TD]Ex7
[/TD]
[TD]PEAR1
[/TD]
[TD]Pears
[/TD]
[TD]56
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]41
[/TD]
[TD]Ex2
[/TD]
[TD]ORANG1
[/TD]
[TD]Oranges
[/TD]
[TD]180
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]52
[/TD]
[TD]Ex8
[/TD]
[TD]LEMON1
[/TD]
[TD]Lemons
[/TD]
[TD]100
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]38
[/TD]
[TD]Ex7
[/TD]
[TD]PEAR1
[/TD]
[TD]Pears
[/TD]
[TD]250
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]22
[/TD]
[TD]Ex1
[/TD]
[TD]APPLE1
[/TD]
[TD]Apples
[/TD]
[TD]250
[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: outer_border, width: 50"]
<tbody>[TR]
[TD]Invoice

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

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?

Thanks In Advance
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
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]
        .Add Dn.Value, Dn.Offset(, 1)
    [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]
       Dic.Add Dn.Value, Dn.Offset(, 1)
    [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
 
Upvote 0
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)

Sorry about that, any solution?
 
Upvote 0
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 !!!
 
Upvote 0
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.
 
Upvote 0
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]
       Dic.Add Dn.Value, Dn.Offset(, 2)
    [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"]If[/COLOR] Not R.Address = .Item(K)(2).Address [COLOR="Navy"]Then[/COLOR] R.Value = 0
                    [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
 
Upvote 0
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.
 
Upvote 0
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]
       Dic.Add Dn.Value, Dn.Offset(, 2)
    [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)
                    R.Value = IIf(R.Address = .Item(K)(2).Address, 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
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Help with an If problem in vba
Replies
4
Views
713
Baziwan
B
Z
  • Solved
Document number not appearing through VBA code
Replies
2
Views
415
Zubair
Z
C
  • Question Question
Find and replace macro for multiple worksheets/items - newbie
Replies
7
Views
1K
DanteAmor
DanteAmor
B
  • Question Question
Help with calculating cost of goods
Replies
1
Views
946
MickG
M
S
  • Question Question
VBA to merge duplicate rows and sum values in column
Replies
1
Views
950
sotplugy
S

Forum statistics

Threads
1,224,820
Messages
6,181,154
Members
453,021
Latest member
Justyna P

Share this page

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top