Extract unique values from a range in excel while disregarding specific values

Question

I originally had an Excel spreadsheet which was used to record values of JOB LOT IDs (>10000). I used the following array formula -

=INDIRECT(TEXT(MIN(IF(($C$3:$S$52<>"")*(COUNTIF($V$3:V3,$C$3:$S$52)=0),ROW($3:$52)*100+COLUMN($C$S),7^8)),"R0C00"),)&""

Data:

| pallet    | Lot#      | Lot#      | Lot#      | Lot#      | Lot#      |
|--------   |-------    |-------    |--------   |-------    |--------   |
| 1         | 12345     | 12346     | 12345     | 12347     | 123456    |
| 2         | 12345     | 12346     | 12348     | 12348     | 12343     |
| 3         | 12345     | 12347     | 123456    | 12348     | 12348     |

This worked fine if the cells in that range all represented the JOB LOT IDs. It would record the unique LOT #'s as I copied this into the result range and coupled with the counting formula

(IF(LEN(V4)>0,COUNTIF($C$3:$S$52,V4),"")

in the adjacent cell. It returned:

Unique  
Value  Count
______ _____
12345    4   
12346    2   
12347    2  
123456   2 
12348    4 
12343    1

Unfortunately, the scope of the job and spreadsheet changed such that the spreadsheet needed to include columns before each JOB LOT cell to record the Case# of the JOB LOT.

What I need help with is figuring out how to disregard the case# data, which will always be between 1 and 451, and only count the unique JOB LOT IDs, which will always be > 100000. Resulting in only the unique list of Job Numbers. Using the same array formula with the added column for Case#, the Case Numbers are also listed, when they are not needed or wanted.

| pallet    | case#     | Lot#      | case#     | Lot#      | case#     | Lot#      | case#     | Lot#      | case#     | Lot#      |
|--------   |-------    |-------    |-------    |-------    |-------    |--------   |-------    |-------    |-------    |--------   |
| 1         | 1         | 12345     | 45        | 12346     | 356       | 12345     | 6         | 12347     | 7         | 123456    |
| 2         | 3         | 12345     | 35        | 12346     | 212       | 12348     | 23        | 12348     | 200       | 12343     |
| 3         | 54        | 12345     | 34        | 12347     | 450       | 123456    | 345       | 12348     | 367       | 12348     |

The result is

Unique
Value   Count
______  _____
12345     4  
45        1
12346     2 
356       1
6         1
12347     2 
7         1  
123456    2 
35        1 
212       1 
12348     4 
23        1 
200       1 
12343     1 
34        1 
450       1 
345       1 
367       1

Any Suugestions? Thanks.

Answer 1

You could use a dictionary to hold the unique Lot# as keys and add one to the value associated with this key each time the key is encountered again.

The data is read in from the sheet, from column C to the right most column, into an array, arr. arr is looped only looking at every other column i.e. the Lot# columns. The contents of the dictionary i.e. the unique Lot# (Keys) and count of them (Items), are written out to sheet2.

It assumes your data starts in A1 and has the layout given in the question.

Option Explicit
Public Sub GetUniqueValueByCounts()
    Dim arr(), i As Long, j As Long, dict As Object, lastColumn As Long, lastRow As Long
    Const NUMBER_COLUMNS_TO_SKIP = 2
    Set dict = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        If lastColumn < 3 Or lastRow < 2 Then Exit Sub

        arr = .Range(.Cells(2, 3), .Cells(lastRow, lastColumn)).Value

        For i = LBound(arr, 2) To UBound(arr, 2) Step NUMBER_COLUMNS_TO_SKIP
            For j = LBound(arr, 1) To UBound(arr, 1)
               If arr(j, i) <> vbNullString Then
                   dict(arr(j, i)) = dict(arr(j, i)) + 1
               End If
            Next
        Next
    End With
    With Worksheets("Sheet2")
        .Range("A1").Resize(dict.Count, 1) = Application.WorksheetFunction.Transpose(dict.Keys)
        .Range("B1").Resize(dict.Count, 1) = Application.WorksheetFunction.Transpose(dict.Items)
    End With
End Sub

---

Ordered results:

You can use a sortedList to get ordered results though you lose the nice .Keys and .Items methods of generating arrays in one go to write to the sheet.

Option Explicit
Public Sub GetUniqueValueByCounts()
    Dim arr(), i As Long, j As Long, dict As Object, lastColumn As Long, lastRow As Long, list As Object
    Const NUMBER_COLUMNS_TO_SKIP = 2
    Set dict = CreateObject("Scripting.Dictionary")
    Set list = CreateObject("System.Collections.SortedList")
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        If lastColumn < 3 Or lastRow < 2 Then Exit Sub

        arr = .Range(.Cells(2, 3), .Cells(lastRow, lastColumn)).Value

        For i = LBound(arr, 2) To UBound(arr, 2) Step NUMBER_COLUMNS_TO_SKIP
            For j = LBound(arr, 1) To UBound(arr, 1)
                If arr(j, i) <> vbNullString Then
                    With list
                        If Not .contains(arr(j, i)) Then
                            list.Add arr(j, i), 1
                        Else
                            list(arr(j, i)) = list(arr(j, i)) + 1
                        End If
                    End With
                End If
            Next
        Next i
    End With
    With Worksheets("Sheet2")
        For j = 0 To list.Count - 1
            .Cells(j + 1, 1) = list.GetKey(j)
            .Cells(j + 1, 2) = list.GetByIndex(j)
        Next
    End With
End Sub