Amending VBA code from a previous thread to match a new set of criteria?

[kidwispa]

Hi All,

A few months ago I posted on here about using VBA to filter data by Agent and then copy each agent's data to a new worksheet and save in a specific directory, and the code given to me by AlphaFrog (thanks again!) has been working perfectly.

I now need to create some code to do the following and thought that the code used from the previous thread could be a good starting point as it does some of the things I need for this new project.

First off, what i need to achieve:

Once the data is sorted (have already done this part myself), I want the code to filter to only show:

1. Column D filtered to show only agent names given on tab entitled "Lookup" (data found in A1:A17)
2. Column E filtered to show all codes that do not begin with "SU"
3. Column L filtered to show only zero values

I would then like this filtered data to be copied into a new worksheet and saved as "Exceptions & today's date (ie Exceptions181011) and saved in the following Directory G:\CW\Exceptions\. The date for this can be found in cell R1 on sheet entitled "DataSort" (where all the data is)

Here is the code AlphaFrog gave me before:

[SIZE=3][FONT=Calibri]Sub Save_Agent_Data()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim wsSource As Worksheet, Lastrow As Long<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim Agents As Range, Agent As Range<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim wbDest As Workbook<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim SavePath As String, AgentFilename As String<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim counter As Long<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Application.ScreenUpdating = False<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Set wsSource = ActiveSheet<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   With wsSource<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       Lastrow = .Range("K" & Rows.Count).End(xlUp).Row<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .Range("K1:K" & Lastrow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       Set Agents = .Range("K2:K" & Lastrow).SpecialCells(xlCellTypeVisible)<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       If .FilterMode Then .ShowAllData<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .Copy<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   End With<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Set wbDest = ActiveWorkbook<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   wbDest.Sheets(1).UsedRange.ClearContents<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   SavePath = "C:\" & Format(Date, "dd.mm.yy") & "\"<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   If Dir(SavePath, vbDirectory) = vbNullString Then MkDir SavePath<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   For Each Agent In Agents<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       wsSource.Range("K:K").AutoFilter Field:=1, Criteria1:=Agent.Value<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       wsSource.UsedRange.SpecialCells(xlCellTypeVisible).Copy _<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           Destination:=wbDest.Sheets(1).Range("A1")<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           AgentFilename = Agent.Value & Format(Date, " ddmmyy") & ".xlsx"<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           On Error Resume Next<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]               wbDest.SaveAs SavePath & AgentFilename, FileFormat:=51<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   '51 = xlOpenXMLWorkbook (without macro's in 2007-2010, xlsx)<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   '52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2010, xlsm)<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           On Error GoTo 0<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           If wbDest.Name = Sub Save_Agent_Data()<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim wsSource As Worksheet, Lastrow As Long<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim Agents As Range, Agent As Range<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim wbDest As Workbook<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim SavePath As String, AgentFilename As String<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Dim counter As Long<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Application.ScreenUpdating = False<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Set wsSource = ActiveSheet<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   With wsSource<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       Lastrow = .Range("K" & Rows.Count).End(xlUp).Row<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .Range("K1:K" & Lastrow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       Set Agents = .Range("K2:K" & Lastrow).SpecialCells(xlCellTypeVisible)<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       If .FilterMode Then .ShowAllData<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .Copy<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   End With<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Set wbDest = ActiveWorkbook<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   wbDest.Sheets(1).UsedRange.ClearContents<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   SavePath = "C:\" & Format(Date, "dd.mm.yy") & "\"<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   If Dir(SavePath, vbDirectory) = vbNullString Then MkDir SavePath<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   For Each Agent In Agents<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       wsSource.Range("K:K").AutoFilter Field:=1, Criteria1:=Agent.Value<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       wsSource.UsedRange.SpecialCells(xlCellTypeVisible).Copy _<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           Destination:=wbDest.Sheets(1).Range("A1")<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           AgentFilename = Agent.Value & Format(Date, " ddmmyy") & ".xlsx"<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           On Error Resume Next<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]               wbDest.SaveAs SavePath & AgentFilename, FileFormat:=51<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   '51 = xlOpenXMLWorkbook (without macro's in 2007-2010, xlsx)<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   '52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2010, xlsm)<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           On Error GoTo 0<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           If wbDest.Name = AgentFilename Then counter = counter + 1<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           wbDest.Sheets(1).UsedRange.ClearContents<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Next Agent<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   wbDest.Close SaveChanges:=False<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   wsSource.AutoFilterMode = False<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Application.ScreenUpdating = True<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   MsgBox counter & " files saved to " & SavePath, vbInformation, "Save Agent Data"<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]End Sub<o:p></o:p>[/FONT][/SIZE]

Thanks for any help!!!

 

[jim may]

What Version of Excel are you?

 

[jim may]

Never mind - I see you're 2010..

 

[kidwispa]

what version of excel are you?

2010

 

[jim may]

Here's a small sample (learning tool) where a Spreadsheet Range is used as Criteria in an Auto-Filter. Perhaps this can help you along....

Sub MyAutoFilter1()
Dim MyArray() As String
Dim Rng As Range
Dim Cnt As Long
Set Rng = Range("M1:M3")  'Your Range of Criteria
Cnt = Rng.Rows.Count
ReDim MyArray(Cnt)
For i = 1 To Cnt
    MyArray(i) = Rng(i)
Next i
ActiveSheet.Range("A3:F11").AutoFilter _
   Field:=3, _
   Criteria1:=MyArray, _
   Operator:=xlFilterValues
End Sub

 

[kidwispa]

Thanks for the input Jim, however I don't really understand what the code you have suggested actually does (have only been using VBA very infrequently for about 6 months or so).

Ideally what I'm looking for is to try and amend the code I've already got to fit the criteria I have in order to learn what each bit does and hopefully then some of it will sink in!!!