Filter Problem On Multiple Columns

Hello All,

I have a sheet that I extract three unique criteria from my table. I then use this criteria to filter the main table by those three criteria. I am extracting unique values of a window construction list, totaling and pasting to a new sheet.

I wrote a similar macro to filter a sheet by two unique criteria and it works great. The same macro on a different sheet will only work with one criteria. As soon as I add the second criteria I have no results in my table.

The first two thirds of the macro work fine. I am intending to loop this macro as soon as I figure out the filter problem. My problem starts at the loop(I think).

I have attached the file.

Thanks for any input.

John W


This is my macro:

Sub SortLWT()
'
' SortLWT Macro
'

 InputSheet = "Wood Parts"
 OutputSheet = "Job Sheet"
'


'Application.ScreenUpdating=False
    LastSortRow = Cells(Rows.Count, 3).End(xlUp).Row
  


    Cells.Select
    ActiveWorkbook.Worksheets(InputSheet).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(InputSheet).Sort.SortFields.Add Key:=Range("E:E"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(InputSheet).Sort.SortFields.Add Key:=Range("D:D"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(InputSheet).Sort.SortFields.Add Key:=Range("C:C"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(InputSheet).Sort
        .SetRange Range("A1:J" & LastSortRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
   Range("K1:S1").EntireColumn.Delete
    
    Dim IRange As Range
    Dim ORange As Range
    
    ' Find the size of today's dataset
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2
    
    ' Set up output range. Copy heading from D1 there
    Range("C1").Copy Destination:=Cells(1, NextCol + 1)
    Range("D1").Copy Destination:=Cells(1, NextCol + 2)
    Range("E1").Copy Destination:=Cells(1, NextCol + 3)
    
    Set ORange = Cells(1, NextCol + 1).Resize(1, 3)
     
    
    ' Define the Input Range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)
    
    ' Do the Advanced Filter to get unique list of customers
    IRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ORange, Unique:=True
    
    'Filter the Range by Three uniques Columns M, N and O
    
    LastUniqueRow = Cells(Rows.Count, 13).End(xlUp).Row
    
    Range("A1:P" & FinalRow).Select
    Selection.NumberFormat = "0.0000"
    
      
    'For k = 2 To 3 'LastUniqueRow
    
            FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
            LengthValue = Cells(2, 13).Value
            WidthValue = Cells(2, 14).Value
            ThicknessValue = Cells(2, 15).Value
            
            Range("Q1").Value = LengthValue
            Range("R1").Value = WidthValue
            Range("S1").Value = ThicknessValue
            
            IRange.AutoFilter Field:=3, Criteria1:=LengthValue
            IRange.AutoFilter Field:=4, Criteria1:=WidthValue
            
            'IRange.AutoFilter Field:=5, Criteria1:=ThicknessValue
            
            'LastFilterRow = Cells(Rows.Count, 1).End(xlUp).Row
            'Range("B2:B" & FinalRow).Select
            'Range("B" & FinalRow + 1).Activate
            'ActiveCell.Value = LastFilterRow - 1
            'Range("C" & LastFilterRow).Resize(1, 3).Select
            'Selection.Copy
            'Range("C" & FinalRow + 1).Select
            'ActiveSheet.Paste
            'Application.CutCopyMode = False
            
            
        
            
        
       'Next k
    
    
    'Selection.AutoFilter
    
      
    
   
    
    Range("A1").Select

'
End Sub