CODEWITHSUNDEEP
listsortingexcelexcel-formulavba
DA69
DA69

Reputation: 91

Excel Sorting a Dynamic List or use VBA then sort

I am using sheet 2 to pull data out of sheet 1.

A9 has this formula in it:

=(INDEX(sheet1!$G$9:$G$7000,MATCH(0,INDEX(COUNTIF($A$8:A8,sheet1!$G$9:$G$7000),0,0),0))

(it looks through column G and takes out duplicates and blanks)

B9 has this formula:

=IF(MAX(IF($A9=sheet1!G:G,sheet1!E:E))=MIN(IF($A9=sheet1!G:G,sheet1!E:E)),"Only 1 Entry",MAX(IF($A9=sheet1!G:G,sheet1!E:E))-MIN(IF($A9=sheet1!G:G,sheet1!E:E)))

(this one looks in column A on sheet2 then looks up dates, Min and Max on Sheet1 to determine how old a certain item is)

C9 has this formula:

=SUMIF(sheet1!$G$9:$G$7000,A9,sheet1!$B$9:$B$7000)

(this on looks as column A in sheet 2 and references sheet1 to add up hours)

The problem is that if I sort Column C on sheet2 nothing changes. I think because as it tries to filter it the dynamic formula is reordering it back to what it is on sheet 1. Basically no matter how you try and filter it, the list stays the same, as its based on sheet1. I even tried to sort the columns on sheet 1 to see if sheet 2 would change but since data in column C of sheet 2 dont actually exist on sheet 1 that doesnt work either.

How can I filter Column C or even B and others with this dynamic formulas that are in place?

I have searched online to find a solution but cant find anything that works. If I can not use this dynamic list, I thought maybe I could create the list in column A sheet 2 with VBA and make the list static.

I have searched too for a VBA to remove duplicated and blanks but for some reason am coming up with a blank on it. I have found some that did part but not both.

Sub MakeUnique()

    Dim vaData As Variant
    Dim colUnique As Collection
    Dim aOutput() As Variant
    Dim i As Long

    'Put the data in an array
    vaData = Sheet1.Range("A5:A7000").Value

    'Create a new collection
    Set colUnique = New Collection

    'Loop through the data
    For i = LBound(vaData, 1) To UBound(vaData, 1)
        'Collections can't have duplicate keys, so try to
        'add each item to the collection ignoring errors.
        'Only unique items will be added
        On Error Resume Next
            colUnique.Add vaData(i, 1), CStr(vaData(i, 1))
        On Error GoTo 0
    Next i

    'size an array to write out to the sheet
    ReDim aOutput(1 To colUnique.Count, 1 To 1)

    'Loop through the collection and fill the output array
    For i = 1 To colUnique.Count
        aOutput(i, 1) = colUnique.Item(i)
    Next i

    'Write the unique values to column B
    Sheet2.Range("A9").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput

End Sub

This VBA creates a list of no duplicates but leaves blanks...

So, how can I have columns B and C on sheet 2 be sortable with column A being derived from data on sheet 1 with no duplicates and no blanks? Is there a way to sort and use the dynamic formula or should it be done with VBA?

Upvotes: 1

Views: 1076

Answers (1)

Gary's Student
Gary's Student

Reputation: 96753

This version of your posted code will not include blanks in the unique list:

Sub MakeUnique()

    Dim vaData As Variant
    Dim colUnique As Collection
    Dim aOutput() As Variant
    Dim i As Long

    'Put the data in an array
    vaData = Sheet1.Range("A5:A7000").Value

    'Create a new collection
    Set colUnique = New Collection

    'Loop through the data
    For i = LBound(vaData, 1) To UBound(vaData, 1)
        'Collections can't have duplicate keys, so try to
        'add each item to the collection ignoring errors.
        'Only unique items will be added
        If vaData(i, 1) <> "" Then
            On Error Resume Next
                colUnique.Add vaData(i, 1), CStr(vaData(i, 1))
            On Error GoTo 0
        End If
    Next i

    'size an array to write out to the sheet
    ReDim aOutput(1 To colUnique.Count, 1 To 1)

    'Loop through the collection and fill the output array
    For i = 1 To colUnique.Count
        aOutput(i, 1) = colUnique.Item(i)
    Next i

    'Write the unique values to column B
    Sheet2.Range("A9").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput

End Sub

Upvotes: 1

Related Questions