Referencing a range with AdvancedFilter

[jaded62]

Hi all.

I'm a decades long lurker here who's probably posted years ago but I don't recall my credentials from that time. Anyway, help would be appreciated.

I have the code for a search form (borrowed from Contextures and modified for my purposes). I can't seem to correctly reference the range RangeTrans for the AdvancedFilter. The code resides in the form.

Cheers.

Option Explicit
    Dim RangeTrans As Range
    Dim RangeRes As Range
    Dim lRowList As Long
    Dim bEventsOff As Boolean
    Dim wsPD As Worksheet
    Dim wsSC As Worksheet
    Dim wsSR As Worksheet

Sub ResultsListUpdate()
   Dim RangeResStart As Range
   Dim lRowSR As Long
  
   Set wsPD = wsProjectData
   Set wsSC = wsSearch
   Set wsSR = wsSearchResult
   Set RangeResStart = wsSearchResult.Range("A1")

   Set RangeTrans = wsPD.Range("ProjDataHeader").CurrentRegion
   Set RangeTrans = RangeTrans.Offset(1, 0).Resize(RangeTrans.Rows.Count - 1, RangeTrans.Columns.Count)
 
  
   Application.ScreenUpdating = False
     
   lstResults.ListIndex = -1

  ClearSearchData
  ClearSelectedTB
 

  With wsSC.Range("CritSearch") _
     .Range(wsSC.Cells(2, 1), wsSC.Cells(2, 3))
     .ClearContents
     .Value = Array(Me.txtSearch01.Value, Me.txtSearch02.Value, "")
  End With
  
    wsPD.Range("RangeTrans").AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=wsSC.Range("CritSearch"), _
        CopyToRange:=RangeResStart, _
        Unique:=False

  lRowSR = 1
  'Find last row in results list
  lRowSR = wsSR.Cells.Find(What:="*", _
    After:=RangeResStart, SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, _
        LookIn:=xlValues).Row
        

   If lRowSR = 1 Then
       lstResults.RowSource = ""
   Else
   'Populate the form's list box (called lstResults) with the results.
       Set RangeRes = RangeResStart.CurrentRegion
       Set RangeRes = RangeRes.Offset(1, 0) _
        .Resize(lRowSR - 1, RangeRes.Columns.Count)
       ActiveWorkbook.Names.Add _
        Name:="RangeRes", RefersTo:=RangeRes
       lstResults.RowSource = "RangeRes"
   End If

exitHandler:
    Application.ScreenUpdating = True
    Exit Sub
errHandler:
   Resume exitHandler

End Sub

 

[DanteAmor]

Welcome again.

It is difficult to test without a data model.

But assuming the headers are in the first row of each data range, then try the following:

I am highlighting in blue the lines that I modified.

Option Explicit

Dim RangeTrans As Range
Dim RangeRes As Range
Dim lRowList As Long
Dim bEventsOff As Boolean
Dim wsPD As Worksheet
Dim wsSC As Worksheet
Dim wsSR As Worksheet

Sub ResultsListUpdate()
  Dim RangeResStart As Range
  Dim lRowSR As Long
  
  Set wsPD = wsProjectData
  Set wsSC = wsSearch
  Set wsSR = wsSearchResult
  Set RangeResStart = wsSearchResult.Range("A1")
  
  Set RangeTrans = wsPD.Range("ProjDataHeader").CurrentRegion
  'Set RangeTrans = RangeTrans.Offset(1, 0).Resize(RangeTrans.Rows.Count - 1, RangeTrans.Columns.Count)
  
  Application.ScreenUpdating = False
  
  lstResults.ListIndex = -1
  
  ClearSearchData
  ClearSelectedTB
  RangeResStart.CurrentRegion.ClearContents
  
  With wsSC.Range("CritSearch") _
    .Range(wsSC.Cells(2, 1), wsSC.Cells(2, 3))
    .ClearContents
    .Value = Array(Me.txtSearch01.Value, Me.txtSearch02.Value, "")
  End With
  
  RangeTrans.AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=wsSC.Range("CritSearch"), _
    CopyToRange:=RangeResStart, _
    Unique:=False
    
  lRowSR = 1
  'Find last row in results list
  lRowSR = wsSR.Cells.Find(What:="*", _
    After:=RangeResStart, SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, _
    LookIn:=xlValues).Row
    
  If lRowSR = 1 Then
    lstResults.RowSource = ""
  Else
    'Populate the form's list box (called lstResults) with the results.
    Set RangeRes = RangeResStart.CurrentRegion
    Set RangeRes = RangeRes.Offset(1, 0) _
      .Resize(lRowSR - 1, RangeRes.Columns.Count)
      ActiveWorkbook.Names.Add _
      Name:="RangeRes", RefersTo:=RangeRes
      lstResults.RowSource = "RangeRes"
  End If
  
exitHandler:
  Application.ScreenUpdating = True
  Exit Sub
errHandler:
  Resume exitHandler

End Sub

Regards
Dante Amor

 

[jaded62]

That works a treat.

I assume the resize code is removed as I need the header info for the filter to work?

Many thanks.

 

[Peter_SSs]

@jaded62
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags in post 1 for you this time.

 

[DanteAmor]

I assume the resize code is removed as I need the header info for the filter to work?

That's correct, in this case the header for the advanced filter is required, also the headers in the criteria range must match the headers in the data range.


Now there is an option to mark an answer as a solution, marking it to the right of the post.

Thanks
Dante Amor