Excel 2010 vba table with Advance Filter copy Unique Values

B

Biz

Well-known Member
Joined
May 18, 2009
Messages
1,773
Office Version
  1. 2021
Platform
  1. Windows
Dear All,

Currently I am using Try macro which trying to create unique Parents Names and then use Filter loop to filter on Parent.

But VBA gives Unique values of all values column F which includes other Child Types which don’t belong to Parent.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
I have bold red where code is failing.

Please note I have duplicate Child names but the belong to correct parent.
Filter criteria parent and trying two use advance produce unique child name list.

Any help would be greatly appreciated.

Code: 
[SIZE=3][FONT=Calibri]Sub try()<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim LR1 As Long, LR2 As Long, i As Long<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim rCells As Range<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]Sheets("Code").Activate<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]Range("CZ:IV").Delete 'remove existing data for testing<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]'Get Unique Depart ID which Parents<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        "AZ1"), Unique:=True<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Columns("AZ:AZ").EntireColumn.AutoFit<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]'Last Row as variable<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    LR1 = Sheets("ABS").Range("AZ" & Rows.Count).End(xlUp).Row<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]'Copy and Paste values<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Range([AZ3], Range("AZ" & LR1 - 1)).Copy<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Range("CZ2").PasteSpecial Paste:=xlPasteValues<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]'Delete Autofilter results are no longer required<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Columns("AZ:AZ").ClearContents<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]'Last Row as variable<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    LR2 = Sheets("ABS").Range("CZ" & Rows.Count).End(xlUp).Row<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    'Colouring Child Yellow<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    With Sheets("ABS").Range("CZ2:CZ" & LR2) ' Last row no to be dynamic<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .Interior.Color = 10092543 'Yellow<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    End With<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    'Colouring Parent Dark Blue<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Range("CZ1") = "Parent"<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Range("CZ1").Interior.Color = 16764057     'Dark blue for heading<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    i = Range("DA1").Column<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    'i = 105 'Column ("DA1")<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    For Each rCells In Sheets("Code").Range("CZ2:CZ" & LR2) 'Last row no to be dynamic<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        With ActiveWorkbook.Worksheets("Code")<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]            .ListObjects(Worksheets("Code").Range("A1").ListObject.Name).Range.AutoFilter 'Removes Autofilter on Table<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]            .ListObjects("Table_aRelationship").Range.AutoFilter Field:=3, Criteria1:=rCells.Value<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]            [/FONT][/SIZE][SIZE=3][FONT=Calibri]End With<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] [/FONT][/SIZE][SIZE=3][FONT=Calibri]'On Error Resume Next<o:p></o:p>[/FONT][/SIZE]
[B][COLOR=red][SIZE=3][FONT=Calibri]        Columns("F:F").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, i), Unique:=True<o:p></o:p>[/FONT][/SIZE][/COLOR][/B]
[SIZE=3][FONT=Calibri]        Selection.Interior.Color = 16777164 'Blue for other cells<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        Selection.ColumnWidth = 25<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        'Selection.EniterColumn.Rows.AutoFit<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        'Selection.EniterColumn.AutoFit<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        Cells(1, i) = rCells.Value 'Column Heading AA3 to LastColumn<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        Cells(1, i).Interior.Color = 16764057     'Dark blue for heading<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        i = i + 1<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Next rCells<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    With ActiveWorkbook.Worksheets("Code")<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]            .ListObjects(Worksheets("Code").Range("A1").ListObject.Name).Range.AutoFilter 'Removes Autofilter on Table 'Remove Filter<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]            .ListObjects("Table_aRelationship").Range.AutoFilter Field:=3 ' Add Filter<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    End With<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    '<<<<==Delete Range Name<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    With ActiveWorkbook<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .Names("Counter").Delete<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .Names("Master").Delete<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .Names("UseList").Delete<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .Names("ValData").Delete<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    End With<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Call AddRangeNames<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    'Speeding Up VBA Code<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    With Application<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .ScreenUpdating = True 'Prevent screen flickering<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .Calculation = xlAutomatic 'Preventing calculation<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .DisplayAlerts = True 'Turn OFF alerts<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        .EnableEvents = True 'Prevent All Events<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    End With<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  <o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]End Sub<o:p></o:p>[/FONT][/SIZE]

Biz
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Hi

It's difficult to understand without seeing the data. Can you post some rows of data, as well as the criteria range if there is one?
 
Upvote 0
Hi pgc01,

Sorry I can't really post the data. I have managed to get it working using Advance filter. Problem was the advanced filter ignores the autofilter, so copies everything.

Thanks mate for trying to help out.

Biz
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
VBA Excel advance filter data and copy to worksheets
2
Replies
13
Views
2K
Fluff
Fluff
K
  • Question Question
VBA code to apply autofilter to table already filtered by date by user via treeview dropdown not working
Replies
0
Views
2K
KathyVBA
K
S
  • Question Question
Need to make Loop in Worksheet & Workbook
Replies
2
Views
659
Sangampmishra
S
J
  • Question Question
Autofilter / Advanced Filter Copying over all data
Replies
1
Views
859
jaspalsd
J
W
  • Solved
How to total unique values in one column between dates in another column?
Replies
1
Views
674
AhoyNC
A

Forum statistics

Threads
1,224,506
Messages
6,179,159
Members
452,892
Latest member
yadavagiri

Share this page

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