Select each of 'filtered' values in a column of Sheet 1 and find their occurences in all values of a column in Sheet 2

user_19903806 0
Viewed 32

I have an Excel worksheet comprised of two sheets.

One (Sheet 1) with a list of products, their respective serial numbers and a part number for a specific part - the users enters one or more serial numbers to filter the complete big list to end up with a smaller list of items

One seperate sheet (Sheet 2) that has only one column, a list of part numbers that need to be replaced

Now I want to write a VBA script that on Worksheet_Calculate() (not reflected below) compares the filtered values of a specific column in Sheet 1 (the column containing the part numbers) with the list/column in Sheet 2 and shows a message box for each product containing a part with a number found in the list of sheet2

But I'm having trouble finding a solution for collecting all filtered cells in Sheet 1

I assume I have to somehow make use of the ListObjects property to collect the specific visible/filtered cells and to compare only those to the list in sheet 2

But I don't really know how to select those specific, auto-filtered, cells or write an iteration that accounts for only those cells but still compares to all rows in the list/column of sheet 2

Right now, despite making use of col1 and col2 as ranges with the 'SpecialCells(xlCellTypeVisible)' attribute it always selects all cells of col1

I'm surprised that this selector

prod1 = Cells(r, col1.Column).Value

despite using col1 (which is a limited range) iterates all values, not just the filtered ones

Sub CompareTwoColumns()
    Dim col1 As Range, col2 As Range, prod1 As String, lr As Long
    Dim incol1 As Variant, incol2 As Variant, r As Long
 
    Set col1 = ActiveSheet.ListObjects("Tabel1").ListColumns.DataBodyRange.SpecialCells(xlCellTypeVisible)
    Set col2 = Worksheets("Tabel2").Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    lr = Worksheets("Tabel1").UsedRange.Rows.Count
    
    Dim cell As Range
               
    For r = 2 To lr
        prod1 = Cells(r, col1.Column).Value
   
        If prod1 <> "" Then
            Set incol2 = col2.Find(prod1, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If incol2 Is Nothing Then
                MsgBox CStr(prod1) + " Not in List"
            Else
                MsgBox CStr(prod1) + " Is in List!"
            End If
        End If
   
    Next r
End Sub

Anyone able to nudge me in the right direction?

vba excel comparison
1 Answers

Match Value in Range

  • Adjust the worksheet, table, and column names.
Option Explicit

Sub ComparePartNumbers()

    ' Often you loop through the cells of the destination worksheet
    ' and try to find a match in the source worksheet (read, copy from)
    ' and then in another column of the destination worksheet you write
    ' e.g. Yes or No (write, copy to).
    ' The analogy doesn't quite apply in this case but I used it anyway.
    
    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source range ('srg').
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet2")
    Dim sTbl As ListObject: Set sTbl = sws.ListObjects("Table2")
    Dim sLc As ListColumn: Set sLc = sTbl.ListColumns("Part Number")
    Dim srg As Range: Set srg = sLc.DataBodyRange
    
    ' Attempt to reference the destination range ('drg').
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1")
    Dim dTbl As ListObject: Set dTbl = dws.ListObjects("Table1")
    Dim dLc As ListColumn: Set dLc = dTbl.ListColumns("Part Number")
    Dim drg As Range
    On Error Resume Next
        Set drg = dLc.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' Validate the destination range.
    If drg Is Nothing Then ' no visible cells
        MsgBox "No filtered values.", vbCritical
        Exit Sub
    'Else ' there are visible cells; do nothing i.e. continue
    End If
    
    ' Declare additional variables.
    Dim dCell As Range ' current destination cell
    Dim dPartNumber As String ' current part number read from the cell
    Dim sIndex As Variant ' the n-th cell where the value was found or an error
    
    ' Loop.
    For Each dCell In drg.Cells
        dPartNumber = CStr(dCell.Value)
        If Len(dPartNumber) > 0 Then ' is not blank
            sIndex = Application.Match(dPartNumber, srg, 0)
            If IsNumeric(sIndex) Then ' is a match
                'MsgBox "'" & dPartNumber & "' is in list!", vbInformation
                Debug.Print "'" & dPartNumber & "' is in list!"
            Else ' is not a match (VBA: 'Error 2042' = Excel: '#N/A')
                'MsgBox "'" & dPartNumber & "' is not in list!", vbExclamation
                Debug.Print "'" & dPartNumber & "' is not in list!"
            End If
        'Else ' is blank; do nothing
        End If
    Next dCell

End Sub
user_98140690
Related