CODEWITHSUNDEEP
arraysexcelvba
Mads Stærmose Kristiansen
Mads Stærmose Kristiansen

Reputation: 1

List all unique values based on criterias

I need to list all values that have a specific criteria in other columns as shown here

I have the following:

Sub arytest()

Dim ary()
Dim note2()
Dim lastrow As Long
Dim i As Long
Dim k As Long
Dim eleAry, x

'Number of rows in my data file
lastrow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

'The maximum length of my array
ReDim ary(1 To lastrow)

k = 1
For i = 1 To lastrow
    If Cells(i, 2) Like "*Note 2*" _   ' Criterias that needs to be fullfilled
    And Cells(i, 1) Like "Actuals" _
    And Cells(i, 4) Like "Digitale Brugere" Then
        ary(k) = Cells(i, 3)
        k = k + 1
    End If
Next i

End Sub

This code lists all values I need. However some of them are present multiple times. How can I remove duplicates?

Upvotes: 0

Views: 50

Answers (1)

Damian
Damian

Reputation: 5174

Here is another way, so you won't need to remove duplicates later, using Scripting Dictionary (you need to check the Microsoft Scripting Runtime on the libraries for this to work)

Sub arytest()

    Dim ary()
    Dim note2() 'unsued
    Dim lastrow As Long
    Dim i As Long
    Dim k As Long
    Dim eleAry, x 'unused
    Dim DictDuplicates As Scripting.Dictionary

    Set DictDuplicates = New Scripting.Dictionary
    'Number of rows in my data file
    lastrow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

    'The maximum length of my array
    ReDim ary(1 To lastrow)

    k = 1
    For i = 1 To lastrow
        ' Criterias that needs to be fullfilled
        If Cells(i, 2) Like "*Note 2*" _
        And Cells(i, 1) Like "Actuals" _
        And Cells(i, 4) Like "Digitale Brugere" Then
            If Not DictDuplicates.Exists(Cells(i, 3).Value) Then 'check if the value is already on the array
                ary(k) = Cells(i, 3)
                DictDuplicates.Add Cells(i, 3).Value, i 'if it does not exists, add it to the dictionary
            End If
            k = k + 1
        End If
    Next i

End Sub

I've also seen some variables unused on your code, or at least what you posted.

PS: when using the Likeoperator you should use the wildcards* or ?, without them is the same as if you were using the = operator.

Upvotes: 1

Related Questions