How can I use multiple saved variables as filter criteria?

See more:

VB

MS-Excel

macros

Hi,

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)
    wb1.Activate
    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"
    wb2.Activate
    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
            Wend
            If StrRefZero <> "" Then
                StrRef = StrRefZero
            End If
        Else
            StrRef = Cells(x, Rng1.Column).Value
            ' Remove leading zeros
            While Left(StrRef, 1) = "0" And StrRef <> ""
                StrRefZero = Right(StrRef, Len(StrRef) - 1)
            Wend
            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
            Do
            ReDim Preserve Filter1(y)
            Filter1(y) = RngFound.Value
            Filter1(y) = CStr(Filter1(y))
            If FoundCells Is Nothing Then
                Set FoundCells = RngFound
            Else
                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.