Advanced filtering based off of another file Vlookup

[ItalianPlatinum]

Hello - I have posted before but I am not getting any hits. so going to keep my problem brief and generic. Hopefully someone could lead me to an answer or refer me to a way to get there.

Existing Code: Will open another worksheet (CSV) and covert it to a format I need to upload. The data within that file has unique characters in column A. In my worksheet where I execute the code from has those same unique values in Column B but also has them grouped by Column A. And what I am looking to do is list out all of the Column A's I want to see in that upload.

Example below: (i only want my upload to show 10 records)

Book2
	A	B	C	D
1	Type	Unique Tag		For Export
2	AA	ABC1		AA
3	AA	BBB1		CC
4	AA	CCC1		EE
5	AA	DDD1
6	BB	ACD1
7	BB	ADD1
8	BB	AFF1
9	BB	AGG1
10	CC	LLL1
11	CC	LLL2
12	CC	LLL3
13	CC	YYY4
14	DD	UUU8
15	DD	PPP0
16	DD	MNM1
17	EE	AFD1
18	EE	DF21
Sheet2

 

[ItalianPlatinum]

Yes - thank you

here is the upload column B2 is where filtering criteria is

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	1a	Symbol	2a	3a	4a	5a	6a	7a	8a	9a	10a	11a	12a	13a	14a	15a	16a	17a	18a	19a	20a	21a
2		ABC1
3		BBB1
4		CCC1
5		DDD1
6		ACD1
7		ADD1
8		AFF1
9		AGG1
10		LLL1
11		LLL2
12		LLL3
13		YYY4
14		UUU8
15		PPP0
16		MNM1
17		AFD1
18		DF21
Converted

 

[Yongle]

I had the 2 files the other way round ???
ie the converted data was starting at row 13 etc, etc

 

[ItalianPlatinum]

I had the 2 files the other way round ???
ie the converted data was starting at row 13

I probably mixed them up myself wouldn't be surprised if I inadvertently did

 

[Yongle]

Let's try again
- replace Execute with correct sheet name
- temp sheet deletion is commented out at the moment so that you can look at it if anything looks wrong in the results

Sub AdvFilter()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim expArr As Variant, tagArr As Variant
    Dim coll As New Collection, App As Application
    Dim a As Long, b As Long, c As Long
    Dim dataRng As Range
    Set ws1 = Sheets("Execute")     'MUST AMEND SHEET NAME
    Set ws2 = Sheets("correct upload")
    Set dataRng = ws2.Range("A1").CurrentRegion
    Set App = Excel.Application
    App.ScreenUpdating = False: App.Calculation = xlCalculationManual
'create arrays of values
    expArr = ws1.Range("X13", ws1.Range("X" & ws1.Rows.Count).End(xlUp).Offset(1)).Value
    tagArr = ws1.Range("A13", ws1.Range("A" & ws1.Rows.Count).End(xlUp)).Resize(, 5).Value
'create filter list
    On Error Resume Next
    For a = 1 To UBound(tagArr)
        For b = 1 To UBound(expArr)
            If tagArr(a, 1) = expArr(b, 1) Then coll.Add CStr(tagArr(a, 5)), CStr(tagArr(a, 5))
        Next b
    Next a
    On Error GoTo 0
    c = coll.Count
'create temp sheet
    Set ws3 = ws2.Parent.Worksheets.Add(after:=ws2)
'add criteria
    ws3.Rows(1).Value = ws2.Rows(1).Value
    For a = 1 To c
        ws3.Cells(a + 1, 2) = coll(a)
    Next a
'add data and filter
    dataRng.Copy ws3.Cells(c + 3, 1)
    Set dataRng = ws3.Cells(c + 3, 1).CurrentRegion
    dataRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ws3.Range("B1").Resize(c + 1), Unique:=False
'copy visible cells to results sheet
    Set ws4 = Sheets.Add(after:=ws2)
    dataRng.SpecialCells(xlCellTypeVisible).Copy ws4.Cells(1, 1)
    App.DisplayAlerts = False
    'ws3.Delete
    App.DisplayAlerts = True
    App.Calculation = xlCalculationAutomatic: App.ScreenUpdating = True
End Sub

Assuming that above works we can then add a few lines to dump the results to another workbook

Exporting Results Sheet to another workbook
Required: Results Sheet exported as CSV and each CSV "goes to its own folder"
Q1 is this correct or do you place several files from the same upload in the same folder?

Q2 Do you want the code to allow you to ...
- browse to the correct main folder (Q3 is there a constant we can use here to get it to default to the correct main folder without browsing?)
- create a new subfolder (Q4 how is subfolder name determined?)
- export results sheet as csv with correct name to that folder (Q5 how is workbook name determined?)

Hopefully this makes it clear what I am referring to ..

sMyFile = "path to correct main folder\" & "own subfolder name\" & "workbook name" & Format(Now, "MMDDYY") & ".csv"

 

[ItalianPlatinum]

Let's try again
- replace Execute with correct sheet name
- temp sheet deletion is commented out at the moment so that you can look at it if anything looks wrong in the results

Sub AdvFilter()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim expArr As Variant, tagArr As Variant
    Dim coll As New Collection, App As Application
    Dim a As Long, b As Long, c As Long
    Dim dataRng As Range
    Set ws1 = Sheets("Execute")     'MUST AMEND SHEET NAME
    Set ws2 = Sheets("correct upload")
    Set dataRng = ws2.Range("A1").CurrentRegion
    Set App = Excel.Application
    App.ScreenUpdating = False: App.Calculation = xlCalculationManual
'create arrays of values
    expArr = ws1.Range("X13", ws1.Range("X" & ws1.Rows.Count).End(xlUp).Offset(1)).Value
    tagArr = ws1.Range("A13", ws1.Range("A" & ws1.Rows.Count).End(xlUp)).Resize(, 5).Value
'create filter list
    On Error Resume Next
    For a = 1 To UBound(tagArr)
        For b = 1 To UBound(expArr)
            If tagArr(a, 1) = expArr(b, 1) Then coll.Add CStr(tagArr(a, 5)), CStr(tagArr(a, 5))
        Next b
    Next a
    On Error GoTo 0
    c = coll.Count
'create temp sheet
    Set ws3 = ws2.Parent.Worksheets.Add(after:=ws2)
'add criteria
    ws3.Rows(1).Value = ws2.Rows(1).Value
    For a = 1 To c
        ws3.Cells(a + 1, 2) = coll(a)
    Next a
'add data and filter
    dataRng.Copy ws3.Cells(c + 3, 1)
    Set dataRng = ws3.Cells(c + 3, 1).CurrentRegion
    dataRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ws3.Range("B1").Resize(c + 1), Unique:=False
'copy visible cells to results sheet
    Set ws4 = Sheets.Add(after:=ws2)
    dataRng.SpecialCells(xlCellTypeVisible).Copy ws4.Cells(1, 1)
    App.DisplayAlerts = False
    'ws3.Delete
    App.DisplayAlerts = True
    App.Calculation = xlCalculationAutomatic: App.ScreenUpdating = True
End Sub

Assuming that above works we can then add a few lines to dump the results to another workbook

Exporting Results Sheet to another workbook
Required: Results Sheet exported as CSV and each CSV "goes to its own folder"
Q1 is this correct or do you place several files from the same upload in the same folder?

Q2 Do you want the code to allow you to ...
- browse to the correct main folder (Q3 is there a constant we can use here to get it to default to the correct main folder without browsing?)
- create a new subfolder (Q4 how is subfolder name determined?)
- export results sheet as csv with correct name to that folder (Q5 how is workbook name determined?)

Hopefully this makes it clear what I am referring to ..

sMyFile = "path to correct main folder\" & "own subfolder name\" & "workbook name" & Format(Now, "MMDDYY") & ".csv"

Ok tested the code two points:
1) it creates 2 new sheets? 1 of which looks correct and the other has duplicated data
2) it only brings over the symbol but all the other data isnt coming with it. for example although for filtering i didnt think it was needed but the other cells will have data in the upload i still require for the symbol.

Q1 - No they will all go to same folder every time but need to be saved in a structured format that cannot change
Q3 - Yes
Q4 - sub folder name is fixed each time wont ever change
Q5 - needs to be saved in a structured format that cannot change ever

 

[ItalianPlatinum]

Ok tested the code two points:
1) it creates 2 new sheets? 1 of which looks correct and the other has duplicated data
2) it only brings over the symbol but all the other data isnt coming with it. for example although for filtering i didnt think it was needed but the other cells will have data in the upload i still require for the symbol.

Q1 - No they will all go to same folder every time but need to be saved in a structured format that cannot change
Q3 - Yes
Q4 - sub folder name is fixed each time wont ever change
Q5 - needs to be saved in a structured format that cannot change ever

my #2 i think is false i just retested and it does copy over

 

[Yongle]

Does the first of the sheets return expected values?

 

[ItalianPlatinum]

Does the first of the sheets return expected values?

Yes it appears to be the second one looks little wonky

 

[Yongle]

It is not wonky!
It is an intermediate (workings) sheet
(See top of post#24)
Simply remove the apostrophe before
ws3.Delete

 

[ItalianPlatinum]

It is not wonky!
It is an intermediate (workings) sheet
(See top of post#24)
Simply remove the apostrophe before
ws3.Delete

oh ok it was intended. apologies wasnt sure