Delete top rows in one table based on content from another table

Question

I am a beginner in VBA.

I have two workbooks, one containing Demand and the other Storage (or Supply).

The demand workbook is ordered by date - from the earliest to the latest.

In the storage workbook I have quantities of each tool to each Machine.

I want to create a subroutine that deletes the earliest first rows in the demand workbook for each tool in the storage workbook. For example, if in storage I have 3 tools of type Aleris, I want to delete the earliest 3 rows in demand that include Aleris.

Here are examples of the workbooks:

Demand:

Storage:

Here is the code I've started, but I'm stuck. If someone can advise me with ideas on how to proceed, or help me with the code I'll be glad.

Option Explicit

Sub Demand_Minus_Storage()
Dim QT As Integer
Dim i As Integer

Dim Demand_WB As Workbook
Set Demand_WB = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\Demand_Optics " & Format(Now(), "dd.mm.yyyy") & ".xlsx")

Dim storage_wb As Workbook
Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm")


storage_wb.Worksheets("Illuminator").Range("C3").Activate
Set QT = ActiveCell.Value
Demand_WB.Worksheets("Illuminators").Activate



End Sub

Answer 1

The beginning is very good :)

Option Explicit

Sub Demand_Minus_Storage()
Dim QT As Long
Dim i As Long
Dim j As Long
Dim lastRow As Long
Dim lastRowDemands As Long
Dim toolName As String

Dim demand_wb As Workbook
Set demand_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\Demand_Optics " & Format(Now(), "dd.mm.yyyy") & ".xlsx")

Dim storage_wb As Workbook
Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm")

'in storage workbook, determine how many rows we have
'I assume that sheets in workbooks you mentioned are first ones!
'generally, use storage_wb.Worksheets("name of the sheet")...
lastRow = storage_wb.Worksheets(1).Cells(2, 1).End(xlDown).Row

'get also last row of table in demands_wb
lastRowDemands = demands_wb.Worksheets(1).Cells(2, 1).End(xlDown).Row

For i = 3 To lastRow
    QT = storage_wb.Worksheets(1).Cells(i, 3).Value 'get QT of tool
    toolName = LCase(storage_wb.Worksheets(1).Cells(i, 1).Value) 'get name of tool, all characters are lowered, in order to better comparison

    'loop through demands table
    For j = 1 To lastRowDemands
        'if tool name is found in E column, delete that row
        If InStr(1, LCase(demands_wb.Worksheets(1).Cells(5, j).Value), toolName) > 0 Then
            demands_wb.Worksheets(1).Rows(j).Delete
            'we have to subtract one from j, so we don't omit any row
            j = j - 1
            'we also have one row less to check
            lastRowDemands = lastRowDemands - 1
            QT = QT - 1 
        End If
        If QT = 0 Then
            'if we deleted the desired amount, then exit loop
            Exit For
        End If
    Next j
Next i
End Sub

Answer 2

First sort your data by date. Then run a For loop and check the value against QT.

Public Sub DeleteFromDemand()

Dim storageRng As Range
Dim demandRng As Range
Dim loopCellStorage As Range
Dim loopcell As Range
Dim cntToDelete As Integer
Dim alreadyDeleted As Integer
'comment make a storage range name.
Set demandRng = Range("DemandRng")
Set storageRng = Range("StorageRng")

For Each loopCellStorage In storageRng.Columns(1).Rows.Cells

For Each loopcell In demandRng.Columns(5).Rows.Cells

    If loopcell.Value Like "*" & loopCellStorage.Value2 & "*" Then
       If alreadyDeleted <= loopCellStorage.Columns(3).Value2 Then
           alreadyDeleted = alreadyDeleted + 1
           loopcell.EntireRow.Delete xlShiftUp
       Else
         Exit For
       End If
    End If
Next loopcell
Next 
End Sub

Try this.

1. Create named ranges for demand and storage data.
2. Loop through the storage cells for value to match and the count. (first For loop)
3. Loop through the demand cells for the column to match and if found note the count to values to be deleted.If this also is true then delete the row else exit. (second for loop)
4. The alreadyDeleted variable keeps a count of rows that are deleted.

Answer 3

This should work exactly as is against your own workbooks, as I've left your code untouched except for Integer -> Long and commenting out the unnecessary lines. (It works fine using my test worksheets.)

Note that it only uses one loop! The inner loop is replaced with filtering and sorting

Sub Demand_Minus_Storage()
  'Dim QT As Long
  'Dim i As Long

  Dim Demand_WB As Workbook
  Set Demand_WB = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\Demand_Optics " & Format(Now(), "dd.mm.yyyy") & ".xlsx")

  Dim storage_wb As Workbook
  Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm")

  'storage_wb.Worksheets("Illuminator").Range("C3").Activate
  'QT = ActiveCell.Value
  Demand_WB.Worksheets("Illuminators").Activate

  Dim rngRow As Range
  With storage_wb.Worksheets("Illuminator")
    For Each rngRow In .Range(.Rows(3), .Rows(WorksheetFunction.Match("*", .Range("A:A"), -1))).Rows
      With Demand_WB.Worksheets("Illuminators").UsedRange.Offset(1)
        .Sort .Columns(5) ' Tool Type
        .Offset(-1).AutoFilter Field:=5, Criteria1:="=" & rngRow.Cells(1) & "*"
        .Sort .Columns(2) ' Due Date
        With .SpecialCells(xlCellTypeVisible).EntireRow.Areas(1)
          Range(.Rows(1), .Rows(WorksheetFunction.Min(rngRow.Cells(3), .Rows.Count))).Delete
        End With
        .Offset(-1).AutoFilter
        .Sort .Columns(2) ' Due Date
      End With
    Next
  End With
  Cells(1).Select

End Sub

Caveat:

This one loop technique will only work if the tool type in the demand table starts with the name of the tool from the storage table.

---

I've also added a tidied and fully documented version, so you can understand how it works:

Sub Demand_Minus_Storage()

  Const n_DemandHeaderRows As Long = 1
  Const i_SN_UTID   As Long = 1
  Const i_Due_Date  As Long = 2
  Const i_Tool_Type As Long = 5
  Const n_StorageHeaderRows As Long = 2
  Const i_Tool  As Long = 1
  Const i_QT    As Long = 3

  Dim rngRow As Range
  Dim ƒ As WorksheetFunction: Set ƒ = WorksheetFunction

  Dim storage_wb As Workbook
  Set storage_wb = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\OpticLabStorage.xlsm")

  Dim Demand_WB As Workbook
  Set Demand_WB = Workbooks.Open("C:\Users\rosipov\Desktop\eliran\MFG - GSS\Demand_Optics " & Format(Now(), "dd.mm.yyyy") & ".xlsx")

  With storage_wb.Worksheets("Illuminator")
    ' Use the worksheet function "Match" to find the last storage used row
    ' Then loop through each storage row
    For Each rngRow In .Range(.Rows(n_StorageHeaderRows + 1), .Rows(ƒ.Match("*", .Columns(i_SN_UTID), -1))).Rows
      ' Skip the header rows and at the same time add at least one row after the end of the table
      With Demand_WB.Worksheets("Illuminators").UsedRange.Offset(n_DemandHeaderRows)
        ' Need to sort by tool type so the rows to be deleted are contiguous
        .Sort .Columns(i_Tool_Type)
        ' Back up to last header row and apply the filter
        ' The filter is for any tool type that starts with the tool in the current storage row
        .Offset(-1).AutoFilter Field:=i_Tool_Type, Criteria1:="=" & rngRow.Cells(i_Tool) & "*"
        ' Need to re-sort by date as we previously sorted by tool type
        .Sort .Columns(i_Due_Date)
        ' Grab the first visible contiguous area. There is always at least the one from the row(s) after the end of the table.
        ' If there are any matching tool tips, these will form an area preceding the end of table area.
        With .SpecialCells(xlCellTypeVisible).EntireRow.Areas(1)
          ' Make sure we don't delete more rows than were actually found.
          ' If none were found, empty rows at the end of the table get deleted.
          Range(.Rows(1), .Rows(ƒ.Min(rngRow.Cells(i_QT), .Rows.Count))).Delete
        End With
        ' Turn autofilter off and show all hidden rows
        .Offset(-n_DemandHeaderRows).AutoFilter
        ' Need to re-sort by date as hidden rows were not sorted in previous date sort
        .Sort .Columns(i_Due_Date)
      End With
    Next
  End With
  ' Tidy up
  Cells(1).Select

End Sub