Resource allocation MACRO

[faizan2086]

Hi,


I am looking for help on Resource allocation MACRO. Below is the detail and small MACRO someone helped me with. Any help would be appreciated. Thanks


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

Below is MACRO someone helped me with but it has errors;

Sub Fill_date()


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


Windows("WIP 6.0.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("K2:K" & 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