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.
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.