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
[TABLE="class: grid, width: 250, align: left"]
<tbody>[TR]
[TD]Part #[/TD]
[TD]Qty[/TD]
[/TR]
[TR]
[TD]SKU 1[/TD]
[TD]200[/TD]
[/TR]
[TR]
[TD]SKU 2[/TD]
[TD]32[/TD]
[/TR]
[TR]
[TD]SKU 3[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]SKU 4[/TD]
[TD]45[/TD]
[/TR]
[TR]
[TD]SKU 5[/TD]
[TD]36[/TD]
[/TR]
</tbody>[/TABLE]










Order

[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]Part #[/TD]
[TD]Qty[/TD]
[TD]Deducted[/TD]
[/TR]
[TR]
[TD]SKU 2[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SKU 1[/TD]
[TD]3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SKU 3[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SKU 5[/TD]
[TD]6[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SKU 6[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SKU 4[/TD]
[TD]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SKU 1[/TD]
[TD]4[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SKU 1[/TD]
[TD]20[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SKU 1[/TD]
[TD]9[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[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