Error - Duplicate record after filtering n the Header can't be copied to new workbook

[JOEYSCLEE]

Hi, there

Recently, the code cannot be run successfully. (The original file name - Filter Testing Example 3)

Errors are Duplicated record (1 of Unique values is duplicated) after running the code and the Header can't be copied to each new workbook.

Meanwhile, the Header is copied to the individual file. Please help to review and advise how to correct the code.:help

21989


Sub Filter()
Dim dic As Object
Dim ws As Worksheet
Dim fName As String
Dim i As Long, Vendor As String
Dim CalcMode As Long

Set dic = CreateObject("scripting.dictionary")

Set ws = ActiveSheet

'Use the INSTR function to find the ".", then use the LEFT to extract everthing before it
fName = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With

With ws.Cells(3, 1).CurrentRegion
For i = 2 To .Rows.Count
Vendor = .Cells(i, 8).Value
If Not dic.exists(Vendor) Then
dic(Vendor) = True
ws.Copy
With ActiveSheet

With .Cells(3, 1).CurrentRegion
.AutoFilter
.AutoFilter 8, "<>" & Vendor
Application.DisplayAlerts = False
.Offset(1).Delete
Application.DisplayAlerts = True
.AutoFilter
End With
Application.Goto .Cells(1)
Application.DisplayAlerts = False
.Parent.SaveAs ws.Parent.Path & "\" & fName & "_" & Vendor & ".xlsx"
Application.DisplayAlerts = True
.Parent.Close
End With
End If
Next
End With

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = CalcMode
End With

End Sub


21988

[mana]

> With ws.Cells(3, 1).CurrentRegion
> With .Cells(3, 1).CurrentRegion


With ws.Range(ws.Cells(3, 1), ws.Cells(Rows.Count, 1).End(xlUp)).Resize(, 11)
For i = 2 To .Rows.Count
Vendor = .Cells(i, 8).Value
If Not dic.exists(Vendor) Then
dic(Vendor) = True
ws.Copy
With ActiveSheet

With .Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 11)

[JOEYSCLEE]

Hi, Mana

It works great!! Thanks for your help again!!:bow: