Advanced Filtering using VBA

[ItalianPlatinum]

Hello - I have a little of modification I am looking to do for my existing VBA. My existing code will open a file, format it, export it to a new workbook then save it as (basically same information below minus column A). the modification i am looking for is to be able to put a criteria in a range and only the data I input will present itself in the export, the caveat being the criteria doesnt end up being in my export file at all. so my export ends up being really just columns C & D. So for this example I only want AA, CC, EE to be in the export

Book2
	A	B	C	D	E	F	G	H	I
1	Type	Category	Unique Tag	Price					Export
2	AA	1	ABC1	10					AA
3	AA	2	BBB1	20					CC
4	AA	3	CCC1	10.5					EE
5	AA	4	DDD1	22
6	BB	1	ACD1	23
7	BB	2	ADD1	45
8	BB	3	AFF1	95
9	BB	4	AGG1	78
10	CC	1	LLL1	45
11	CC	2	LLL2	65
12	CC	3	LLL3	37
13	CC	4	YYY4	19
14	DD	2	UUU8	82
15	DD	3	PPP0	34
16	DD	4	MNM1	82
17	EE	1	AFD1	71
18	EE	2	DF21	17
Sheet1

 

[ItalianPlatinum]

sorry forgot my code

commadelimited = formats and saves the file as CSV
c2 = flips between files to copy and paste data

Sub C()
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
  
Application.ScreenUpdating = False
  
'Clear Sheet
With Sheets("C")
    .Cells.ClearContents
End With
  
'Clear C2 Upload Sheet
With Sheets("C2")
   .Range("A2:V" & rows.count).ClearContents
End With
  
    sPath = "MYPATH\"      ' <<<<< change accordingly
  
    sPartial = "MYPATH_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.csv"
    sFName = Dir(sPath & sPartial)
    If Len(sFName) > 0 Then
        Workbooks.OpenText sPath & sFName

With Sheets("mypathxx_")
   .Range("A:Z").Copy
End With

Workbooks("Compare").Sheets("C").Range("A1").PasteSpecial
Workbooks("Compare").Sheets("C").Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

CommaDelimited2

Workbooks(sFName).Close SaveChanges:=False
C2

Application.ScreenUpdating = True

    Else
        MsgBox "File not found.", vbExclamation
    End If

End Sub

 

[DanteAmor]

Put the criteria to filter in column "I" of sheet "C" (as you put in your example of I2:I4)

The following code opens the csv file, filters column A, copies columns C to D, and pastes on sheet "C" in cell A1.

Sub C()
  Dim sPath As String, sPartial As String, sFName As String
  Dim shC As Worksheet
  
  Application.ScreenUpdating = False
  
  Set shC = Sheets("C")
  shC.Range("A:B").ClearContents
  Sheets("C2").Range("A2:V" & Rows.Count).ClearContents
  
  sPath = "MYPATH\"      ' <<<<< change accordingly
  sPartial = "MYPATH_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.csv"
  sFName = Dir(sPath & sPartial)
  If Len(sFName) > 0 Then
    Workbooks.OpenText sPath & sFName
    With ActiveSheet
      .Range("A1").AutoFilter 1, Application.Transpose(shC.Range("I2", shC.Range("I" & Rows.Count).End(3))), xlFilterValues
      .AutoFilter.Range.Range("C1:D" & .Range("A" & Rows.Count).End(3).Row).Copy shC.Range("A1")
    End With
    
    CommaDelimited2
    Workbooks(sFName).Close SaveChanges:=False
    C2
  Else
    MsgBox "File not found.", vbExclamation
  End If
  Application.ScreenUpdating = True
End Sub