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

kidwispa

Active Member
Joined
Mar 7, 2011
Messages
330
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:

Code:
[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!!!

:)
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
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....

Code:
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
 
Upvote 0
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!!!

:)
 
Upvote 0

Forum statistics

Threads
1,224,802
Messages
6,181,053
Members
453,014
Latest member
Chris258

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
Back
Top