user9078057
user9078057

Reputation: 187

Dynamic List on the Basis of a COUNTIF Function

List I        List II
A             G
B             X
I             R
G             L
H             U
K             A
L             S
N
R

Under the Following List I have used the CountIF Function to count the elements that are found in List II but not in List I. Subsequently, I created a column titled CountIF that then gets populated with 1 or 0. Then I opened a new sheet and used the following formula IF(CountIF_Column=1;"";Entry from List II).

The problem: The list that is created in the new sheet has many empty cells. I want to have a list without white spaces, and without having to manually delete the empty cells.

My ideas: Could I insert a dynamic Name for the list with spaces and then somehow clear the empty spaces? Do not know how to do it... Any help is appreciated.

Upvotes: 0

Views: 163

Answers (1)

QHarr
QHarr

Reputation: 84465

You can use arrays and a dictionary (will preserve unique values only). The following assumes list1 is in Column A, and list2 is in column B, and writes out the values from list2, not in list1, in column C. Also, assumes there are headers in row 1.

Option Explicit
Public Sub test()
    Dim arr1(), arr2(), outputList As Object
    Dim lastRow1 As Long, lastRow2 As Long, i As Long
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row

        If lastRow1 = 2 Then
            ReDim arr1(1, 1): arr1 = .Range("A2").Value
        Else
            arr1 = .Range("A2:A" & lastRow1).Value
        End If
        If lastRow2 = 2 Then
            ReDim arr2(1, 1): arr1 = .Range("B2").Value
        Else
            arr2 = .Range("B2:B" & lastRow2).Value
        End If

        arr1 = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr1, 0, 1))
        Set outputList = CreateObject("Scripting.Dictionary")

        For i = LBound(arr2, 1) To UBound(arr2, 1)
            If Not IsEmpty(arr2(i, 1)) Then
                If IsError(Application.Match(arr2(i, 1), arr1, 0)) Then
                    outputList(arr2(i, 1)) = 1
                End If
            End If
        Next
        If outputList.Count > 0 Then
            .Range("C2").Resize(outputList.Count, 1) = Application.WorksheetFunction.Transpose(outputList.keys)
        End If
    End With
End Sub

Upvotes: 1

Related Questions