Click here to Skip to main content
14,267,679 members

How can I use multiple saved variables as filter criteria?

b.wag asked:

Open original thread

I'm trying to create a macro to match 2 data sets. One data set is always the same regarding layout and the kind of data, but the other data set is different every time.

I am trying to find all matching entries using common references while also creating a 'link' between the two files (it's basically just a column which includes the row number of the matching entry so it can be manually checked afterwards in case a 100% match isn't achieved).

This is the code I am currently using:
Variable declaration:
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Rng As Range
Dim Rng1 As Range
Dim LastColwb1 As Long
Dim RngFind As Range
Dim LastRow1 As Long
Dim x As Long
Dim StrRef As String
Dim StrRefZero As String
Dim RngFound As Range
Dim LastRowFind As Long
Dim y As Long
Dim z As Long
Dim w As Long
Dim RngDate As Range
Dim RngDate2 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Rng4 As Range
Dim Rng5 As Range
Dim Rng6 As Range
Dim Rng7 As Range
Dim StrDate As Date
Dim LastCellwb1 As Range
Dim Filter1() As String
Dim Filter2 As String
Dim Filter3 As String
Dim Filter4 As String
Dim RngPallet As Range
Dim RngPallet2 As Range
Dim StrPallet As String
Dim RngUnitType As Range
Dim RngUnitType2 As Range
Dim StrUnitType As String
Dim RngFormula As Range
Dim var As Variant
Dim FirstResult As String
Dim FoundCells As Range

Partial code where issue is:
' Crop reference to useable string
If Not Rng Is Nothing Then
    Set Rng1 = Cells(1, Rng.Column)
    LastColwb1 = wb1.Sheets("RPD8").Cells(4, Columns.Count).End(xlToLeft).Column
    Set RngFind = wb1.Sheets("RPD8").Range("A4:" & ColumnLetter(LastColwb1) & "4").Find("Full Ref")
    LastRowFind = wb1.Sheets("RPD8").Range("A" & Rows.Count).End(xlUp).Row
    wb1.Sheets("RPD8").Range("AV5:AV" & LastRowFind).Formula = "=AL5&"" ""&AM5"
    LastRow1 = wb2.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    ' Loop through all possible references
    For x = 2 To LastRow1
        ' Clear all filters
        wb1.Sheets("RPD8").Range("A4:" & LastCellwb1).AutoFilter Field:=33
        wb1.Sheets("RPD8").Range("A4:" & LastCellwb1).AutoFilter Field:=48
        wb1.Sheets("RPD8").Range("A4:" & LastCellwb1).AutoFilter Field:=49
        wb1.Sheets("RPD8").Range("A4:" & LastCellwb1).AutoFilter Field:=25
        ' Only use common reference part
        If Len(Cells(x, Rng1.Column)) > 5 Then
            StrRef = Right(Cells(x, Rng1.Column).Value, 5)
            While Left(StrRef, 1) = "0" And StrRef <> ""
                StrRefZero = Right(StrRef, Len(StrRef) - 1)
                StrRef = StrRefZero
            If StrRefZero <> "" Then
                StrRef = StrRefZero
            End If
            StrRef = Cells(x, Rng1.Column).Value
            ' Remove leading zeros
            While Left(StrRef, 1) = "0" And StrRef <> ""
                StrRefZero = Right(StrRef, Len(StrRef) - 1)
            If StrRefZero <> "" Then
                StrRef = StrRefZero
            End If
        End If
        ' Do a search for the reference until no more matches can be found
        Set RngFound = wb1.Sheets("RPD8").Range(RngFind.Address & ":" & ColumnLetter(RngFind.Column) & LastRowFind) _
        .Find(StrRef, LookIn:=xlValues)
        If Not RngFound Is Nothing Then
            ' Save the first found reference
            FirstResult = RngFound.Address
            ' Variable handling for search
            y = 0
            ReDim Preserve Filter1(y)
            Filter1(y) = RngFound.Value
            Filter1(y) = CStr(Filter1(y))
            If FoundCells Is Nothing Then
                Set FoundCells = RngFound
                Set FoundCells = Union(RngFound, FoundCells)
            End If
            ' Find the next reference
            Set RngFound = wb1.Sheets("RPD8").Range(RngFind.Address & ":" & ColumnLetter(RngFind.Column) _
            & LastRowFind).FindNext(RngFound)
            y = y + 1
            Loop While Not RngFound Is Nothing And FirstResult <> RngFound.Address
            ' Filter on found matches
            wb1.Sheets("RPD8").Range("A4:" & LastCellwb1).AutoFilter Field:=48, _
            Criteria1:=Filter1, Operator:=xlFilterValues
            wb1.Sheets("RPD8").Range("AX5:" & LastRowFind).SpecialCells(xlCellTypeVisible).Value = "X"
            wb1.Sheets("RPD8").Range("BB5:" & LastRowFind).SpecialCells(xlCellTypeVisible).Value = x
        End If

Everything works perfectly (so far) until I reach this part:
' Filter on found matches
wb1.Sheets("RPD8").Range("A4:" & LastCellwb1).AutoFilter Field:=48, _
Criteria1:=Filter1, Operator:=xlFilterValues

Filter1(y) has several entries: (differs every time so just using random letters)
- Filter1(1) = xxxx
- Filter1(2) = yyyy
- Filter1(3) = zzzz
- ...

I have to narrow my data set down to these entries in order to further match these entries in the code that follows. The code that follows is using single criteria filters so I'm not expecting any issues there.

If anybody has any ideas, it would be most welcome.

FYI, no errors occur, the filter action just never happens. I can, full disclosure, manually filter using the Filter1(y) values so it should be possible.

What I have tried:

I tried reworking this part a couple of times but never managed to get all the Filter1(y) values (or any) in a filter. Maybe a different approach is needed, but I haven't found the inspiration for that.
Tags: VB, macros, Excel


When answering a question please:
  1. Read the question carefully.
  2. Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
  3. If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
  4. Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.
Let's work to help developers, not make them feel stupid.
Please note that all posts will be submitted under the The Code Project Open License (CPOL).

CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100