Vlookup To subtract Order Qty From Supply and Mark additional Cell

[sharpold78]

I am relativly new to VBA. I am in need of some code that will assist me in looking up information on a sheet (Orders) from a sheet (Supply) and subtracting the order value from the supply value. If Order Qty < Supply Qty and the deduction is calculated I also need it to place an x in an additional column next to the order. In the event that there is not supply I need it to ignore the line and move to the next. Also if Vlookup is not the most efficient way I am open to other suggestions. Any help would be greatly appreciated.


Supply

Part #	Qty
SKU 1	200
SKU 2	32
SKU 3	1
SKU 4	45
SKU 5	36

<tbody>
</tbody>

Order

Part #	Qty	Deducted
SKU 2	1
SKU 1	3
SKU 3	1
SKU 5	6
SKU 6	1
SKU 4	5
SKU 1	4
SKU 1	20
SKU 1	9

<tbody>
</tbody>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG08Sep19
[COLOR="Navy"]Dim[/COLOR] oRng        [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] sRng        [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] R           [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]With[/COLOR] Sheets("Order")
    [COLOR="Navy"]Set[/COLOR] oRng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Supply")
    [COLOR="Navy"]Set[/COLOR] sRng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] oRng
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Dn.Value, Dn.Offset(, 1)
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Dic.Item(Dn.Value) = Union(Dic.Item(Dn.Value), Dn.Offset(, 1))
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
oRng.Offset(, 3) = vbNullString
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] sRng
    [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value) = vbNullString [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dic(Dn.Value)
            [COLOR="Navy"]If[/COLOR] Dn.Offset(, 1).Value >= R [COLOR="Navy"]Then[/COLOR]
                Dn.Offset(, 1).Value = Dn.Offset(, 1).Value - R
                R.Offset(, 1) = R
                R.Offset(, 2) = "X"
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sharpold78]

Mick,

Thank you so much. I should have mentioned this in my original thread. I am working on a Mac with excel 2011. When I try and run the Macro I get error "Run-time error 429 ActiveX component cant create." After some research I found that this type of VBA component can not run on a native Mac OS. Would you happen to have any other ideas?

 

[MickG]

Try this:-
Not quite sure where you wat the "X"'s, so may need slight mod.

[COLOR=navy]Sub[/COLOR] MG10Sep02
[COLOR=navy]Dim[/COLOR] oRng        [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] sRng        [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Rs           [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Ro           [COLOR=navy]As[/COLOR] Range
[COLOR=navy]With[/COLOR] Sheets("Order")
    [COLOR=navy]Set[/COLOR] oRng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Supply")
    [COLOR=navy]Set[/COLOR] sRng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
oRng.Offset(, 2).Resize(, 2).ClearContents
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Ro [COLOR=navy]In[/COLOR] oRng
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Rs [COLOR=navy]In[/COLOR] sRng
        [COLOR=navy]If[/COLOR] Ro = Rs [COLOR=navy]Then[/COLOR]
            [COLOR=navy]If[/COLOR] Rs.Offset(, 1) >= Ro.Offset(, 1) [COLOR=navy]Then[/COLOR]
                Ro.Offset(, 2) = Ro.Offset(, 1)
                Ro.Offset(, 3) = "X"
                Rs.Offset(, 1) = Rs.Offset(, 1) - Ro.Offset(, 1)
            [COLOR=navy]End[/COLOR] If
         [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Rs
[COLOR=navy]Next[/COLOR] Ro
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[sharpold78]

I believe I can get that to work for my purposes. Thank you so much for the quick response and help.

 

[MickG]

Your welcome
Regrds Mick