Transfer Items on a List by Quantity

[nniedzielski]

I am currently running a Macro that takes items from a List:

And I run this code to scroll through the Master Inventory worksheet and pulls anything that is on this list onto the Fruits Tab, then removes some un-needed columns, and does some formatting.

With Worksheets("Lists")
        mtArray = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
    End With
    With Sheets("Master Inventory")
        .Range("A1:S1").AutoFilter field:=1, Criteria1:=Application.Transpose(mtArray), Operator:=xlFilterValues
        .AutoFilter.Range.Copy Sheets("Fruits").Range("A1")
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .Range("A1:S1").AutoFilter
    End With
    With Sheets("Fruits").Range("D:S")
        .EntireColumn.Delete
    End With
    With Sheets("Fruits").Range("A1:C1")
        .Font.Bold = True
    End With
    With Sheets("Fruits").UsedRange.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Sheets("Fruits").UsedRange.EntireColumn.AutoFit

What I need to add to this functionality is the ability to set a Max number of Fruits:

In this i would only want the macro to grab the first 12 rows of data with Lemons in it, first 5 with Oranges and so on and so forth and move them to the fruits tab.

How can i add this in?

thank you as always for any help, Stay safe

 

[Fluff]

Glad to hear that & thanks for the feedback

 

[DanteAmor]

For whatever reason, my work laptop will not allow me to do Run dictionary.

You tried adding the reference:

Go to References ->
Select “Microsoft Scripting Runtime”

I'm going to use Peter's formula, but using the autofilter, try this option:

Sub test2()
  Dim lr As Long, sh As Worksheet, m
  
  Set sh = Sheets("Master Inventory")
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("A" & Rows.Count).End(3).Row
  sh.Range("Z2:Z" & lr).Formula = "=COUNTIF(A$2:A2,A2)<=VLOOKUP(A2,Lists!C:D,2,0)"
    
  sh.Range("A1:Z" & lr).AutoFilter 26, "TRUE"
  sh.AutoFilter.Range.Range("A:C").Copy Sheets("Fruits").Range("A1")
  With Sheets("Fruits")
    .UsedRange.Borders.LineStyle = xlContinuous
    .UsedRange.EntireColumn.AutoFit
  End With
  sh.AutoFilter.Range.Offset(1).EntireRow.Delete
  sh.ShowAllData
  sh.Range("Z:Z").ClearContents
End Sub