Autofilter Dynamic List Including Single Value

jl1066

New Member
Joined
Mar 22, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
I was looking for some guidance on auto filtering a dynamic set of values. I'm trying to auto filter a list of supplier names and after each name in the list copy the results into a blank Excel report and email the workbook to a user. Once the email is sent then the filter would move on to the next value and process the list until there are no more supplier names to filter, copy and email.

I have the logic working well if there are multiple values in the list of supplier names, but if there is only one name then the code will not filter for the only supplier name, but will return a null value and then continue with the copy and email function. If I remove the "-1" in the fourth row, the filter will go through the list of supplier names and will also filter for a null value at the end of the list (this will email a blank report to a user and is not desirable).

Column AB contains the list of values that I am filtering range A1:V1 on. Cell AB3 contains the title of the list.

This is my current code:

Dim aNames As Variant, Itm As Variant

With Range("AB3", Range("AB" & Rows.Count).End(xlUp))
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
aNames = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).Value
Range("A1:V1").AutoFilter
For Each Itm In aNames
.AutoFilter Field:=3, Criteria1:=Itm


Range("A1").CurrentRegion.Select
Selection.Copy
Workbooks.Add
Set Workbook = ActiveWorkbook
Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
Range("A1").PasteSpecial Paste:=xlPasteFormats
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.DisplayAlerts = False
Range("X1").Value = Format(Now, "yyyy")

Dim Path1 As String
Dim Path2 As String

Path1 = Range("C2")
Path2 = Range("X1")

ActiveWorkbook.SaveAs file location
Emlreport = file location

Dim Email As Outlook.Application
Set Email = New Outlook.Application
Dim Sr As String
Dim newmail As Outlook.MailItem
Dim Email_Send_To As String
Set newmail = Email.CreateItem(olMailItem)
Email_Send_To = Workbooks("Supplier Status Report Macro.xlsm").Sheets("Menu").Range("D3").Value
newmail.To = Email_Send_To
newmail.Subject = Path1 & " Open Status Report"
Sr = Emlreport
newmail.attachments.Add Sr
newmail.send

Workbooks("Supplier Status Report Macro.xlsm").Activate

Next Itm
.AutoFilter
End With


Any help would be much appreciated.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
Maybe you can use this:
VBA Code:
Sub filter()
    Dim aNames() As Variant, Itm As Variant, i As Long
    Dim rNames As Range, cll As Range
    If Range("AB3", Range("AB" & Rows.Count).End(xlUp)).Count = 1 Then Exit Sub
    With Range("AB3", Range("AB" & Rows.Count).End(xlUp))
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        Set rNames = .SpecialCells(xlVisible)
    End With
    i = 0
    ReDim Preserve aNames(0 To rNames.Count - 1)
    For Each cll In rNames
        aNames(i) = cll.Value
        i = i + 1
    Next
    With Range("A1:V1")
        For i = 1 To rNames.Count - 1
            .AutoFilter Field:=3, Criteria1:=aNames(i)
        Next
        .AutoFilter
    End With
End Sub
 

jl1066

New Member
Joined
Mar 22, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
That worked perfectly! Thanks for the help.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,302
Messages
5,641,423
Members
417,209
Latest member
Agbarker

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top