Is there a way to use VBA to compare two tables on separate sheets and see if they match/meet criteria?

146 views Asked by At

I've been trying to create a code that allowed me to compare one table (in this case, an inventory listing) with another table (customer part specification). I was thinking about creating a loop that will search the inventory table by tag number (column A), reference several attributes of it (Class, gauge, width, etc') and then search the part number table for those attributes (exact class, gauge range, width range, etc). If it found a match, I'd want it to show me the part number that matched, or at least that there's a MATCH.

I'm not familiar with looping or offsetting reference tags, so I'm not sure how to best approach this. Any help will be greatly appreciated! I am very new to VBA, and am learning as I go along.

Here is the code I've created a manual search. It requires that you select the tag you want to search, and references the attributes above the part number table:

Sub FilterInventoryToPartSearch()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

'   Filter Active Inventory

    Dim lo5 As ListObject
    Set lo5 = Sheet5.ListObjects(1)
    lo5.AutoFilter.ShowAllData
    With lo5.Range
'   Filter by Material Type

    If Sheet5.Range("f2").Text <> "" Then
        .AutoFilter field:=5, Criteria1:=Sheet5.Range("f2").Text
    End If

'   Filter by Gauge

    If Sheet5.Range("f3").Value <> "" Then
        .AutoFilter field:=7, Criteria1:="<=" & Sheet5.Range("f3").Value
    End If
    If Sheet5.Range("f3").Value <> "" Then
        .AutoFilter field:=8, Criteria1:=">=" & Sheet5.Range("f3").Value
    End If

'   Filter by Width

    If Sheet5.Range("f4").Value <> "" Then
        .AutoFilter field:=9, Criteria1:="<=" & Sheet5.Range("f4").Value
    End If

'   Filter by Max Weight

    If Sheet5.Range("f6").Value <> "" Then
        .AutoFilter field:=6, Criteria1:=">=" & Sheet5.Range("f6").Value
    End If

'   Filter by Length

    If Sheet5.Range("f5").Value <> "0" Then
        .AutoFilter field:=11, Criteria1:=">=" & Sheet5.Range("f5").Value
    End If


End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Here is a text example of the inventory listing

TagNo   Class   Gauge   Width   Length  Wgt 
383891  GALV    0.0274  55.125  0       10140
389763  GALV    0.0277  46.102  0       33382
392471  HRPO    0.1026  8.5     0       4420
395949  CRFH    0.1235  59.736  0       45760
416268  HR      0.067   51.8262 0       36760
416897  CR      0.0197  1.5354  0       7482
416898  CR      0.0197  1.5354  0       6782
416899  CR      0.0197  1.5354  0       6712
416900  CR      0.0197  1.5354  0       7528
416901  CR      0.0197  1.5354  0       6790
416902  CR      0.0197  1.5354  0       6764

Here is an example of the part number list :

INDEX   Customer    PartNumber      PartDesc                    MaterialType    MaxWgt  MinGage MaxGage Width   WidthTolerance  Length 
1       B1          .0138 X 2.161"  CR .0150 X 2.161            CR              3500    0.0142  0.0165  2.161   +/- 0.006       0
15      E1          .050 X 2.995    .050 X 2.995"               HR              3363    0.05    0.058   2.995   +/- 0.005       0
27      C1          04518G48        HD G60 CTD .045M X 48 X C   GALV            18000   0.044   0.049   48.124  -3              0

And for clarity, as images

example of the inventory listing

example of the part number table and specs

2

There are 2 answers

0
FaneDuru On

Test this please and also check if the rules you supplied are correct. In the files you sent, there is no match...

Private Sub InventoryInterpretation()
 Dim strFoldPath As String, w As Workbook, wInv As Workbook, shI As Worksheet
 Dim wSpec As Workbook, shS As Worksheet, boolInv As Boolean, boolSpec As Boolean
 Dim strSpec As String, strInv As String, arrInv As Variant, arrSp As Variant, arrRez() As String
 Dim i As Long, s As Long, strclass As String

  strFoldPath = "Your folder path"
  strSpec = strFoldPath & "\" & "Specification1.txt" 'user your file name
  strInv = strFoldPath & "\" & "Inventory1.txt"      'user your file name

  For Each w In Workbooks 'check if the necessary .txt/.csv files are opened in Excel:
    If w.FullName = strSpec Then Set wSpec = w: boolSpec = True
    If w.FullName = strInv Then Set wInv = w: boolInv = True
  Next
  If Not boolInv Then
    If Dir(strInv) <> "" Then 'check if file exists
      Set wInv = Workbooks.Open(strInv)
    Else
      MsgBox "No Inventory file in folder """ & strFoldPath & """.": Exit Sub
    End If
  End If
  If Not boolSpec Then ' if the spec file is not opened in Excel
      If Dir(strSpec) <> "" Then 'check if file exists
        Set wSpec = Workbooks.Open(strSpec)
      Else
        MsgBox "No Specification file in folder """ & strFoldPath & """.": Exit Sub
      End If
  End If
  Set shI = wInv.Sheets(1): Set shS = wSpec.Sheets(1)
  arrInv = shI.Range("A1").CurrentRegion.Value: ' Debug.Print UBound(arrInv, 1), UBound(arrInv, 2)
  arrSp = shS.Range("A1").CurrentRegion.Value: 'Debug.Print UBound(arrSp, 1), UBound(arrSp, 2)
  ReDim arrRez(UBound(arrInv, 1))
  'Making the real job:
  shI.Cells(1, UBound(arrInv, 2) + 2).EntireColumn.Clear ' clear the column where data are returned
  For i = 2 To UBound(arrInv, 1)
    strclass = arrInv(i, 3) 'col 3 of inventory array
    For s = 2 To UBound(arrSp, 1)
        If arrSp(s, 6) = strclass Then
            Stop
            If CDbl(arrInv(i, 4)) >= CDbl(arrSp(s, 8)) And _
                    CDbl(arrInv(i, 4)) <= CDbl(arrSp(s, 9)) And _
                    CDbl(arrInv(i, 5)) >= CDbl(arrSp(s, 10)) And _
                     CDbl(arrInv(i, 7)) <= CDbl(arrSp(s, 7)) Then
                arrRez(i) = "OK - " & strclass: Exit For
            Else
                Debug.Print CDbl(arrInv(i, 4)) >= CDbl(arrSp(s, 8))
                Debug.Print CDbl(arrInv(i, 4)) <= CDbl(arrSp(s, 9))
                Debug.Print CDbl(arrInv(i, 5)) >= CDbl(arrSp(s, 10))
                Debug.Print CDbl(arrInv(i, 7)) <= CDbl(arrSp(s, 7))
                arrRez(i - 1) = "No" & " - " & i: Exit For
            End If
        End If
    Next s
  Next i

  shI.Range(shI.Cells(1, UBound(arrInv, 2) + 2), shI.Cells(UBound(arrInv, 1), _
                    UBound(arrInv, 2) + 2)).Value = WorksheetFunction.Transpose(arrRez)
  wInv.Activate: shI.Activate
End Sub

Please use the code as inspiration and for learning purpose... It respects the rules you settled, but not any match exists between the two files. Please revise the files or the rules.

And let me know what from the above suppositions matches the reality...

0
adiyomtov On

Turns out, using MATCH INDEX for each of the criteria worked very efficiently. Rather than cycling through the inventory, it was able to evaluate each parameter, and display a value if all conditions were true. Thank you for all the help!