Create unique list from a column display the results in a drop down using the Ribbon bar display the filter on the worksheet

Question

I have 29,000 plus rows on a sheet called DataCalcs. In column AG I have values like the following:

Altern 1
Altern 1
Altern 1
Altern 1
Altern 1
Altern 1
Base   2
Base   2
Base   2
Base   2
Base   2

and so on in column AG

I need code that will filter this data and display what is filtered from a custom Menu I have created on the Excel Ribbon.

I also need the data to be displayed on the DataCalcs worksheet when the menu on the drop down from the Ribbon Bar is selected based on the unique selections in column AGthat are filtered.

I also have saved this data in a range called DataCalcs so please feel free to use that named range in the code.

Thanks for looking and reading!

So... what have you tried so far? – Olle Sjögren Feb 11 '19 at 12:52 — Olle Sjögren, Feb 11 '19 at 12:52
https://stackoverflow.com/help/how-to-ask – Olle Sjögren Feb 11 '19 at 12:53 — Olle Sjögren, Feb 11 '19 at 12:53

simple-solution · Answer 1 · 2019-02-12T09:59:09.450

These procedures do the work:
Sub AdvFilter is actually just one line of code.
Sub AdvFilterSort includes the possibility to sort the result.

Option Explicit

'Sub AdvFilter and Sub AdvFilterSort
'based on https://stackoverflow.com/questions/32787227/vba-advanced-filter-unique-values-and-copy-to-another-sheet

Sub AdvFilter(InputRange As Range, OutputRange As Range)
    InputRange.AdvancedFilter Action:=xlFilterCopy, copytorange:=OutputRange, Unique:=True
End Sub

Sub AdvFilterSort(InputRange As Range, OutputRange As Range, Optional sortHeader As Integer, Optional sortAscOrDesc As Integer)
    Dim sortRange As Range
    InputRange.AdvancedFilter Action:=xlFilterCopy, copytorange:=OutputRange, Unique:=True
    If sortAscOrDesc = xlAscending Or sortAscOrDesc = xlDescending Then
        Set sortRange = OutputRange.CurrentRegion
        sortRange.Sort key1:=OutputRange, Order1:=sortAscOrDesc, Header:=sortHeader
    End If
End Sub

This procedure calls AdvFilter/AdvFilterSort with your "DataCalcs" data:

Option Explicit

Sub Call_AdvFilter()
    Dim agRange As Range
    Dim lastRow As Long

    'Create a new sheet for the results : "newSheet"

    If sheetExists("newSheet") Then
        'nothing to do
    Else
        'create sheet and name it "newSheet"
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = "newSheet"
    End If
    lastRow = Worksheets("DataCalcs").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    Set agRange = Range("DataCalcs!AG1:AG" & lastRow)

    'Delete result columns
    Range("newsheet!A:H").Delete

    With Worksheets("newSheet")
        .Range("A1:H3").Font.Bold = True
        .Range("A1:H1").Font.Size = 14
        .Range("A3:H3").Font.Size = 12

        'using column ag data defined with lastrow
        .Range("A1").Value = "Column AG data (lastrow):"

        'result sorted:
        .Range("A3").Value = "sorted"
        Call AdvFilterSort(Range("DataCalcs!AG1:AG3340"), .Range("A5"), xlNo, xlAscending)

        'result not sorted:
        .Range("C3").Value = "not sorted"
        Call AdvFilter(Range("DataCalcs!AG1:AG3340"), .Range("C5"))


        'using predefined range named "DataCalcs"
        .Range("F1").Value = "defined Name ""DataCalcs"":"

        'result sorted:
        .Range("F3").Value = "sorted"
        Call AdvFilterSort(Range("DataCalcs"), .Range("F5"), xlNo, xlAscending)

        'result not sorted:
        .Range("H3").Value = "not sorted"
        Call AdvFilter(Range("DataCalcs"), .Range("H5"))

    End With
End Sub

This is a nice sheetExists function used above:

Function sheetExists(sheetToFind As String) As Boolean
    'copied from:
    'https://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists
    'by Dante is not a Geek
    'https://stackoverflow.com/users/571433/dante-is-not-a-geek
    Dim mySheet As Worksheet
    sheetExists = False
    For Each mySheet In Worksheets
        If sheetToFind = mySheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next mySheet
End Function

Create unique list from a column display the results in a drop down using the Ribbon bar display the filter on the worksheet

1 Answers1