Forecast shortages

[BrutalDawg]

Hello,

I am trying to be able to better identify shortages without as many steps for other users that are not as fluent in excel. Currently, all I do is take my sales order filter down to 3-4 weeks and run a combination script:

Sub CombineRows()
'Updated 20150511
Dim WorkRng As Range
Dim Dic As Variant
Dim arr As Variant
On Error Resume Next
xTitleId = "Stock-INSERT-DATE-HERE"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")
arr = WorkRng.Value
For i = 1 To UBound(arr, 1)
Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
Next
Application.ScreenUpdating = False
WorkRng.ClearContents
WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
Application.ScreenUpdating = True
End Sub

Then I utilize a simple conditional formatting rule that highlights any item that is less than Stock. This creates a lot of leg work of verifying when the PO will deliver compared to the sales order. I am trying to develop a tool, where I can have the Sales Orders on Sheet1, Stock on Sheet2, and better identification of shortages. For example stock:

Item Number	Quantity
1a1	200
2b2	305

<tbody>
</tbody>

Example Sales Orders:

Location	PurchaseOrderNumber	Part Number	Timing	Quantity	When
80	0	1a1	Planning	50	11/1/2016
72	0	1a1	Planning	50	11/1/2016
80	0	2b2	Planning	100	11/1/2016
80	A437B	1a1	Planning	50	11/8/2016
72	A8683B	1a1	Planning	100	11/8/2016
72	A893	2b2	Planning	50	11/8/2016
65	0	1a1	Planning	75	11/15/2016
80	0	2b2	Planning	75	11/15/2016
65	A437B	2b2	Planning	100	11/15/2016
80	A7893	2b2	Planning	120	11/22/2016
65	B7820	1a1	Planning	100	11/22/2016

<tbody>
</tbody>

with an example output of:

Location	PurchaseOrderNumber	Part Number	Timing	Quantity	When	Short Quantity
80	0	1a1	Planning	50	11/1/2016
72	0	1a1	Planning	50	11/1/2016
80	0	2b2	Planning	100	11/1/2016
80	A437B	1a1	Planning	50	11/8/2016
72	A8683B	1a1	Planning	100	11/8/2016	50
72	A893	2b2	Planning	50	11/8/2016
65	0	1a1	Planning	75	11/15/2016	0
80	0	2b2	Planning	75	11/15/2016
65	A437B	2b2	Planning	100	11/15/2016	20
80	A7893	2b2	Planning	120	11/22/2016	0
65	B7820	1a1	Planning	100	11/22/2016	0

<tbody>
</tbody>

Is this possible with the SO's having split quantities?

Thanks for any suggestions!

 

[AlphaFrog]

You may be able to do the shortages with a formula.

Put this in G2 and copy it down the column...

=IF(VLOOKUP(C2,Sheet1!A:B,2,0)< SUMIF($C$1:C2,C2,$E$1:E2),SUMIF($C$1:C2,C2,$E$1:E2)-VLOOKUP(C2,Sheet1!A:B,2,0),"")<sumif($c$1:c2,c2,$e$1:e2),sumif($c$1:c2,c2,$e$1:e2)-vlookup(c2,sheet1!a:b,2,0),"")< html=""></sumif($c$1:c2,c2,$e$1:e2),sumif($c$1:c2,c2,$e$1:e2)-vlookup(c2,sheet1!a:b,2,0),"")<>

 

[MickG]

Try this:-
Stock on sheet2 (actual data starts "A2")
Sales Order on Sheet1 (actual Data starts "A2"

[COLOR="Navy"]Sub[/COLOR] MG31Oct42
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, P [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic1 [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant, Dic2 [COLOR="Navy"]As[/COLOR] Object, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic1 = CreateObject("scripting.dictionary")
Dic1.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: Dic1(Dn.Value) = Dn.Offset(, 1).Value: [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("C2"), .Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic2 = CreateObject("scripting.dictionary")
Dic2.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]If[/COLOR] Not Dic2.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic2.Add Dn.Value, Array(Nothing, Dn.Offset(, 2))
        [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) > Dic1(Dn.Value) [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Dic2(Dn.Value)(0) = Dn
    [COLOR="Navy"]Else[/COLOR]
        Q = Dic2(Dn.Value)
           Q(1) = Q(1) + Dn.Offset(, 2)
            [COLOR="Navy"]If[/COLOR] Q(1) > Dic1(Dn.Value) [COLOR="Navy"]Then[/COLOR]
              [COLOR="Navy"]If[/COLOR] Q(0) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                  [COLOR="Navy"]Set[/COLOR] Q(0) = Dn
              [COLOR="Navy"]Else[/COLOR]
                  [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
              [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]End[/COLOR] If
        Dic2(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic2.keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] P [COLOR="Navy"]In[/COLOR] Dic2(K)(0)
        P.EntireRow.Font.Color = vbRed
    [COLOR="Navy"]Next[/COLOR] P
 [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[BrutalDawg]

Thanks Mick,

I am receiving Run-time error '424':
Object required.

When I debug I get For Each P In Dic2(K)(0)

I have notice it does not discover the first shortage. For example the request 200 pieces but only 150 are in stock, the next order is highlighted red not the original short.

Alpha - Your formula appears to work. Assuming #N/A means it is not found in stock. Is there a way you can remove all suffix's - such as a1a-exact to just a1a without having to find a replace each? There are about 60 or so with that suffix that constantly change.

 

[BrutalDawg]

Would it be possible to add a rolling total to H? This way, with Alpha's formula I could add conditional formatting to highlight the entire row for better visibility.

Thanks for the help!

 

[AlphaFrog]

Alpha - Your formula appears to work. Assuming #N/A means it is not found in stock. Is there a way you can remove all suffix's - such as a1a-exact to just a1a without having to find a replace each? There are about 60 or so with that suffix that constantly change.

Are the suffixes on the Sales Orders and not on Stock?
Do all suffixes start with a dash?
Is the item number always the first three characters?

Describe in detail the actual part numbers and the suffixes.


Suffixes aside, you can remove the #/N/A results by wrapping the formula in an IFERROR function
=IFERROR(formula, "No product match")

 

[MickG]

Try this example with code :-
https://app.box.com/s/g2zjvxsbbg3ekxkpff75vcnjxp9vds8e

 

[BrutalDawg]

Thank you that fixed the N/A problem.

The suffixes are on the stock only, used as an internal reference. The item numbers can be formatted differently depending on the customer, but in general it is a 7 digit number followed, followed by a revision. Examples:
1234567
9876543B1
2589631B81

However; the only suffix used is -exact for all items. -- It is a local reference to let users know it must be exact quantity. For example 1234567C1-exact .

Would it be possible to add a rolling total to H? As below: your formula in the G

Location	PurchaseOrderNumber		Part Number	Timing	Quantity	When	Short Quantity	Rolling Stock
80		0	1A1	Planning	50	11/1/2016		150
72		0	1a1	Planning	50	11/1/2016		100
80		0	2b2	Planning	100	11/1/2016		205
80	A437B		1a1	Planning	50	11/8/2016		50
72	A8683B		1a1	Planning	100	11/8/2016	50	-50
72	A893		2b2	Planning	50	11/8/2016		155
65		0	1a1	Planning	75	11/15/2016	125	-125
80		0	2b2	Planning	75	11/15/2016		80
65	A437B		2b2	Planning	100	11/15/2016	20	-20
80	A7893		2b2	Planning	120	11/22/2016	140	-140
65	B7820		1A1	Planning	100	11/22/2016	225	-225

<colgroup><col><col><col span="4"><col><col><col></colgroup><tbody>
</tbody>

 

[BrutalDawg]

Mick,

This seems to work well. How would I utilize the code when I have new purchase orders, or stock? Is it possible to have a continuous stock count in cell H?

 

[MickG]

Try this for "Rolling Stock" (column "H")

[COLOR="Navy"]Sub[/COLOR] MG01Nov28
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Fd [COLOR="Navy"]As[/COLOR] Boolean
[COLOR="Navy"]Dim[/COLOR] Dic1 [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant, Dic2 [COLOR="Navy"]As[/COLOR] Object, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic1 = CreateObject("scripting.dictionary")
Dic1.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: Dic1(Dn.Value) = Dn.Offset(, 1).Value: [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("C2"), .Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic2 = CreateObject("scripting.dictionary")
Dic2.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]If[/COLOR] Not Dic2.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
     Dic2.Add Dn.Value, Array(Dn.Offset(, 2), Fd)
        Q = Dic2(Dn.Value)
            Dn.Offset(, 5) = Dic1(Dn.Value) - Q(0)
            [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) > Dic1(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                Dn.EntireRow.Font.Color = vbRed
                [COLOR="Navy"]If[/COLOR] Not Q(1) [COLOR="Navy"]Then[/COLOR] Dn.Offset(, 4) = Q(0) - Dic1(Dn.Value)
                Q(1) = True
            [COLOR="Navy"]End[/COLOR] If
        Dic2(Dn.Value) = Q
   [COLOR="Navy"]Else[/COLOR]
         Q = Dic2(Dn.Value)
            Q(0) = Q(0) + Dn.Offset(, 2)
            Dn.Offset(, 5) = Dic1(Dn.Value) - Q(0)
            [COLOR="Navy"]If[/COLOR] Q(0) > Dic1(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                Dn.EntireRow.Font.Color = vbRed
                [COLOR="Navy"]If[/COLOR] Not Q(1) [COLOR="Navy"]Then[/COLOR] Dn.Offset(, 4) = Q(0) - Dic1(Dn.Value)
                Q(1) = True
            [COLOR="Navy"]End[/COLOR] If
        Dic2(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick