Assign exact dates of material availability to each production order

[faizan2086]

Below is a brief description of what I am trying to do. In nut shell;


"I want to give my production line exact date and comments when material is coming"


The date and comments are given to me by procurement and it can be min 1 ETA or max 3 ETA. Attached is a worksheet with MACRO I tried. Any help would be appreciated


Details below;

Statement:

2 Sheets
Sheet 'Data file' contains column EA as item # corresponding to Summary tab Col C item#
Data file Column EG, EH, EI contains 1st Earliest availability date, quantity and comments
Data file Column EJ, EK, EL contains 2nd availability date, quantity and comments
Data file Column EM, EN, EO contains 3rd availability date, quantity and comments
Sheet 'Summary' contains the item requirement as per production#, Item# and required quantity
'Summary' Col B contains Production number( which is unique)
'Summary' Col C contains Item number (which has to match to Sheet 'Data file', col EA)
'Summary' Col K contains requirement quantity
Sheet 'Summary' is sorted based on multiple requirements, so data cannot be manipulated

Task:
To fill up Comments & ETA date in Summary sheet based on material availability in Data file sheet

Problem Statement:

• Lookup item# ‘Summary’ col C vs ‘data file’ col EA
• If found, match required qty (summary col K) to available qty (data file Col EH, EK, EN) incrementally (i.e. if EH cannot fulfill the col K, qty, add EK qty and assign EK’s comments and ETA to summary tab col N,O, similarly if EH, EK cannot fulfill K, use EH, EK, EN and put EN comments.
• Whatever last qty from EH, EK, EN satisfies the demand in Col K, assign relevant comments and ETA to accordingly in Summary tab col N,O
• After every qty from (EH, EK, EN) is assigned to K, subtract if to make new available qty to match col K
• If all available ends and there are still match left in Summary sheet col C, assign last ETA date + 15 days to rest all matches.
• Refresh all variables for next match

Example

• If data matches, Go to col K and (Summary tab) and look up value against quantity in (data file) EH, EK and EN
  
  • If quantity (col k)<= qty (col EH)
    
    • Assign corresponding ETA and comments in Col EI to (Summary tab) col N,O
    • decrease available qty col EH and GOTO NEXT LINE
    • If quantity (col k) <= qty (col EH (decreased qty)+EK)
      
      • Assign corresponding ETA and comments in Col EL to (Summary tab) col N,O
      • decrease available qty col EH+EK and GOTO NEXT LINE
      • If quantity (col k) > qty (col EH+EK(decreased qty)+EN)
      • Assign corresponding ETA and comments in Col EO to (Summary tab) col N,O
      • decrease available qty col EH+EK+EN and GOTO NEXT LINE
      • Remaining all matches to be assigned date 15 days+ last ETA date
      
      
    • Assign corresponding ETA and comments in Col EI to (Summary tab) col N,O
    • Do for approx. 4000 item# in Summary tab.
    
    

MACRO I tried:
Sub fillBoM1()

Dim shAv As Worksheet, shRq As Worksheet, lr As Long, c As Range, fn As Range
Dim vlA As Long, vlB As Long, vlC As Long, dtA As Date, dtB As Date, dtC As Date, dtD As Date

Windows("Task.xlsm").Activate
Set shAv = Sheets("Data file")
Set shRq = Sheets("Summary")
lr = shRq.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
For Each c In shRq.Range("N2:N" & lr)
Set fn = shAv.Range("EA:EA").Find(c.Value, , xlValues, xlWhole)
If Not fn Is Nothing Then
vlA = fn.Offset(, 8).Value
vlB = fn.Offset(, 11).Value
vlC = fn.Offset(, 14).Value
dtA = fn.Offset(, 6).Value
dtB = fn.Offset(, 9).Value
dtC = fn.Offset(, 12).Value
dtD = Application.EDate(dtC, 1)
If vlA >= c.Offset(, 1).Value Then
c.Offset(, 2) = dtA
fn.Offset(, 2) = vlA - c.Offset(, 1).Value
ElseIf (vlA + vlB) >= c.Offset(, 1).Value Then
c.Offset(, 2) = dtB
fn.Offset(, 2) = 0
fn.Offset(, 5) = vlB - (c.Offset(, 1).Value - vlA)
ElseIf (vlA + vlB + vlC) >= c.Offset(, 1).Value Then
c.Offset(, 2) = dtC
fn.Offset(, 2) = 0
fn.Offset(, 5) = 0
fn.Offset(, 8) = vlC - (c.Offset(, 1).Value - (vlA + vlB))
Else
fn.Offset(, 2) = 0
fn.Offset(, 5) = 0
fn.Offset(, 8) = 0
c.Offset(, 2) = dtD
End If
End If
Next
End Sub