Production Schedule

G

Greygoose

New Member
Joined
Sep 6, 2013
Messages
7
Greetings,

I'm currently working on a file that takes the code of a product and returns the next available production date that could supply the demand of this product.

The file is set up in two sheets: A and B.

In sheet A:
CodeDemandProduction Date
11111000???????
82722500???????

<TBODY>
</TBODY>

In sheet B:

CODE01/201302/201303/201304/201305/201306/201307/201308/201309/2013
11105002001000
11116002000500
2222100
2223200
3333
82721005002500
9999500

<TBODY>
</TBODY>


The idea is to take the product code, look for it in the second sheet, compare the different productions to the demand and return the date of the production that can supply it.

I've used vlookup and hlookup but they don't do the trick... Please help

Thank you in advance for your attention
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
Hi Greygoose - With your data in a sheet called Greygoose and your production in a sheet called Greygoose2 try the following starting in sheet Greygoose.

Code: 
Sub Greygoose()
    Dim Code As String
    Dim DateFound As String
    
    Dim total_needed, total As Integer
    Dim x As Integer 'Used to increment rows in Greygoose
    Dim i As Integer 'Used to increment rows in Greygoose2
    Dim j As Integer 'Used to increment columns
    i = 2
    j = 2
    x = 2
        
'Start the macro from sheet "Greygoose"
While Cells(x, 1) <> ""
    Code = Cells(x, 1).Value
    total_needed = Cells(x, 2).Value
'Go to second sheet
Sheets("Greygoose2").Select
'Find Row for code
While Cells(i, 1) <> ""
If Cells(i, 1).Value = Code Then
    While total < total_needed
      total = Cells(i, j).Value + total
        If total > total_needed Then
          DateFound = Cells(1, j).Value
          Sheets("Greygoose").Select
          Cells(x, 3) = DateFound
          MsgBox DateFound
        End If
      j = j + 1
    Wend
End If
i = i + 1
Wend
x = x + 1
i = 2
j = 2
total = 0
total_needed = 0
Wend
End Sub
 
Last edited by a moderator:
Upvote 0
Thank you so much goesr! That works great.

However I have an additional complication that is challenging.

The sheet with the demand includes several demand entries of the same product but with different demands.
DCODEDEMANDPRODUCTION
111111000
282722500
32222100
41110200
51111300
61110300
711111000
88272100
98272600

<TBODY>
</TBODY>

If the productions have to be served by the first production available and, in the case the produced quantity isn't enough, the remaining production needs to be assigned to the next production. Then, how can I get as a result the dates of the two or more productions?

Now, the additional difficulty is that the next demand on the same product needs to consider the earlier assignments to be assigned to the next available production.

Very grateful if someone can provide guidance.
 
Upvote 0
Try this in conjunction with your new "Demand" list on "sheet A" and you original Production Dates/Quantity list on "Sheet "B".
Code: 
[COLOR=Navy]Sub[/COLOR] MG20Nov36
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ac          [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ray
[COLOR=Navy]Dim[/COLOR] oSum        [COLOR=Navy]As[/COLOR] Double
[COLOR=Navy]Dim[/COLOR] R           [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] C           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object


[COLOR=Navy]With[/COLOR] Sheets("Sheet A")
    [COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & 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] 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]
        [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]


[COLOR=Navy]With[/COLOR] Sheets("Sheet B")
    [COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
oSum = 0
    [COLOR=Navy]If[/COLOR] Dic.exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
        ReDim Ray(1 To Dic.Item(Dn.Value).Count, 1 To 2)
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Dic.Item(Dn.Value)
                C = C + 1
                Ray(C, 1) = R.Value: Ray(C, 2) = R.Address
            [COLOR=Navy]Next[/COLOR] R


        [COLOR=Navy]For[/COLOR] Ac = 1 To .Cells("1", Columns.Count).End(xlToLeft).Column
            C = 0
            oSum = oSum + Dn.Offset(, Ac)
               [COLOR=Navy]For[/COLOR] n = 1 To UBound(Ray)
                   [COLOR=Navy]If[/COLOR] Not Ray(n, 1) = 0 And oSum >= Ray(n, 1) [COLOR=Navy]Then[/COLOR]
                        oSum = oSum - Ray(n, 1)
                        Ray(n, 1) = 0
                        Range(Ray(n, 2)).Offset(, 1) = Format(.Range("A1").Offset(, Ac), "mmm-yyyy")
                   [COLOR=Navy]End[/COLOR] If
              [COLOR=Navy]Next[/COLOR] n
        [COLOR=Navy]Next[/COLOR] Ac
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Results from Data:-

DCODEDEMANDPRODUCTION
111111000May-13
282722500Jun-13
32222100Jul-13
41110200Feb-13
51111300Mar-13
61110300Feb-13
711111000May-13
88272100Feb-13
98272600May-13

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


Regards Mick
 
Upvote 0
Thank you MickG,

This solves part of the problem. However, the Demands should be First-Come-First-Served for each product. Therefore, the solution should involve placing the first demand in the first available production (even if the production is not sufficient). Then the next Demand for the same Code should be assigned to the next production that has available quantity (either part of the production or the full production hasn't been assigned). And the result should print the dates of the production OR productions that are assigned to serve the demand of that Code.

The solution should in this case be something like:

DCODEDEMANDPRODUCTION
11111100003/2013 :: 05/2013
28272250002/2013 :: 05/2013 :: 06/2013
3222210007/2013
4111020002/2013
5111130005/2013
6111030002/2013
71111100005/2013
8827210006/2013
9827260006/2013

<TBODY>
</TBODY>


Thank you in advance for your feedback.
 
Upvote 0
Try this:-
Code: 
[COLOR=Navy]Sub[/COLOR] MG20Nov11
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ac          [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ray
[COLOR=Navy]Dim[/COLOR] oSum        [COLOR=Navy]As[/COLOR] Double
[COLOR=Navy]Dim[/COLOR] R           [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] C           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Rw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Application.ScreenUpdating = False
[COLOR=Navy]With[/COLOR] Sheets("Sheet A")
    [COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & 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] 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]
        [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]




Ray = Sheets("Sheet B").Range("A1").CurrentRegion
[COLOR=Navy]For[/COLOR] Rw = 1 To UBound(Ray, 1)
   C = 0
   oSum = 0
   [COLOR=Navy]If[/COLOR] Dic.exists(Ray(Rw, 1)) [COLOR=Navy]Then[/COLOR]
   ReDim nRay(1 To Dic.Item(Ray(Rw, 1)).Count, 1 To 2)
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Dic.Item(Ray(Rw, 1))
                C = C + 1
                nRay(C, 1) = R.Value: nRay(C, 2) = R.Address
            [COLOR=Navy]Next[/COLOR] R
                
                [COLOR=Navy]For[/COLOR] Ac = 2 To UBound(Ray, 2)
                        oSum = oSum + Ray(Rw, Ac)
                            For n = 1 To UBound(nRay, 1) 
                                [COLOR=Navy]If[/COLOR] oSum > 0 And nRay(n, 1) > 0 [COLOR=Navy]Then[/COLOR]
                                    [COLOR=Navy]If[/COLOR] nRay(n, 1) > oSum [COLOR=Navy]Then[/COLOR]
                                        nRay(n, 1) = nRay(n, 1) - oSum
                                        oSum = 0
                                        Range(nRay(n, 2)).Offset(, 1) = Range(nRay(n, 2)).Offset(, 1) & Format(Sheets("Sheet B").Range("A1").Offset(, Ac - 1), "mmm-yyyy") & Chr(10)
                                    [COLOR=Navy]ElseIf[/COLOR] oSum >= nRay(n, 1) [COLOR=Navy]Then[/COLOR]
                                        oSum = oSum - nRay(n, 1)
                                        nRay(n, 1) = 0
                                        Range(nRay(n, 2)).Offset(, 1) = Range(nRay(n, 2)).Offset(, 1) & Format(Sheets("Sheet B").Range("A1").Offset(, Ac - 1), "mmm-yyyy") & Chr(10)
                                    [COLOR=Navy]End[/COLOR] If
                                [COLOR=Navy]End[/COLOR] If
                            [COLOR=Navy]Next[/COLOR] n
                [COLOR=Navy]Next[/COLOR] Ac
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Rw
Application.ScreenUpdating = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
Wow Mick,

It works perfect! Thank you!

If I wanted it to also print the quantities each demand takes from each different production (if that's the case) how could I include that?

Thank you again for your help!
 
Upvote 0
Try this for a new column, "E" Quantities.
Code: 
[COLOR=navy]Sub[/COLOR] MG23Nov31
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Ac          [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Ray
[COLOR=navy]Dim[/COLOR] oSum        [COLOR=navy]As[/COLOR] Double
[COLOR=navy]Dim[/COLOR] R           [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] C           [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Dic         [COLOR=navy]As[/COLOR] Object
[COLOR=navy]Dim[/COLOR] Rw [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Application.ScreenUpdating = False
[COLOR=navy]With[/COLOR] Sheets("Sheet A")
    [COLOR=navy]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & 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] 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]
        [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]

Ray = Sheets("Sheet B").Range("A1").CurrentRegion
[COLOR=navy]For[/COLOR] Rw = 1 To UBound(Ray, 1)
   C = 0
   oSum = 0
   [COLOR=navy]If[/COLOR] Dic.exists(Ray(Rw, 1)) [COLOR=navy]Then[/COLOR]
   ReDim nRay(1 To Dic.Item(Ray(Rw, 1)).Count, 1 To 2)
            [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Dic.Item(Ray(Rw, 1))
                C = C + 1
                nRay(C, 1) = R.Value: nRay(C, 2) = R.Address
            [COLOR=navy]Next[/COLOR] R
                
                [COLOR=navy]For[/COLOR] Ac = 2 To UBound(Ray, 2)
                        oSum = oSum + Ray(Rw, Ac)
                            For n = 1 To UBound(nRay, 1) 
                                [COLOR=navy]If[/COLOR] oSum > 0 And nRay(n, 1) > 0 [COLOR=navy]Then[/COLOR]
                                    [COLOR=navy]If[/COLOR] nRay(n, 1) > oSum [COLOR=navy]Then[/COLOR]
                                        nRay(n, 1) = nRay(n, 1) - oSum
                                        Range(nRay(n, 2)).Offset(, 1) = Range(nRay(n, 2)).Offset(, 1) & Format(Sheets("Sheet B").Range("A1").Offset(, Ac - 1), "mmm-yyyy") & Chr(10)
                                        Range(nRay(n, 2)).Offset(, 2) = Range(nRay(n, 2)).Offset(, 2) & oSum & Chr(10)
                                        oSum = 0
                                    [COLOR=navy]ElseIf[/COLOR] oSum >= nRay(n, 1) [COLOR=navy]Then[/COLOR]
                                        oSum = oSum - nRay(n, 1)
                                        Range(nRay(n, 2)).Offset(, 1) = Range(nRay(n, 2)).Offset(, 1) & Format(Sheets("Sheet B").Range("A1").Offset(, Ac - 1), "mmm-yyyy") & Chr(10)
                                        Range(nRay(n, 2)).Offset(, 2) = Range(nRay(n, 2)).Offset(, 2) & nRay(n, 1) & Chr(10)
                                        nRay(n, 1) = 0
                                    [COLOR=navy]End[/COLOR] If
                                [COLOR=navy]End[/COLOR] If
                            [COLOR=navy]Next[/COLOR] n
                [COLOR=navy]Next[/COLOR] Ac
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Rw
Application.ScreenUpdating = True
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question
Vlookup with multiple conditions
2
Replies
10
Views
805
kweaver
kweaver
SkywardPalm
  • Question
Best Match (Fuzzy Match Alternative) for Product Description and Pulling Respective Product ID Code
Replies
5
Views
562
Akuini
Akuini
D
  • Solved
Need help with formula (Match/Index?)
Replies
3
Views
441
Fluff
Fluff
N
  • Question
First in First Out (Fifo) Stock balance Calaculation File.
Replies
2
Views
9K
TotallyConfused
T
G
  • Question
Vlookup from particular cells
Replies
2
Views
590
GirishDhruva
G

Forum statistics

Threads
1,215,990
Messages
6,128,158
Members
449,428
Latest member
d4vew

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