Extract unique values from disjoint columns

[aayush_agarwal]

Hi, I am new to VBA in excel and would request your help to solve my problem. I am currently working on a problem which involves extracting unique string values from 14 disjoint columns in excel. Each column in my data has around 500 string values with few blank cells in between. The 14 columns are not next to each other.
The solutions i have found are for 3 columns which are place next to each other.
I would like to construct a formula/VBA code which can do the same for 14 columns. The data in each of the columns will be updated dynamically with time. Also note that all the values are string values.
I would request you to kindly provide any suggestions or solutions for this problem.
I have also attached an image showing sample data for your reference.
Thanks a lot for your help.

 

[Domenic]

Can you post the exact code that you're using?

 

[aayush_agarwal]

Hi, @Domenic the exact code i am using is as follows :

Sub GetUniqueValuesFromNonContiguousColumns()

    Dim dicUniqueValues As Object
    Dim varColumns As Variant
    Dim rngColumn As Range
    Dim rngCell As Range
    Dim lastRow As Long
    Dim i As Long
    
    Set dicUniqueValues = CreateObject("Scripting.Dictionary")
    dicUniqueValues.CompareMode = vbTextCompare 'case-insensitive
    
    varColumns = Array("H", "Q", "AD") 'change and/or add as desired
    
    For i = LBound(varColumns) To UBound(varColumns)
        lastRow = Cells(Rows.Count, varColumns(i)).End(xlUp).Row
        If lastRow >= 7 Then
            Set rngColumn = Range(varColumns(i) & "7:" & varColumns(i) & lastRow)
            For Each rngCell In rngColumn
                If Not IsError(rngCell) Then
                    If Len(rngCell) > 0 Then
                        dicUniqueValues(rngCell.Value) = ""
                    End If
                End If
            Next rngCell
        End If
    Next i
    
    Worksheets("Sheet5").Range("A2").Resize(dicUniqueValues.Count).Value = Application.Transpose(dicUniqueValues.keys()) 'change the sheet name and cell location as desired
    
    Set dicUniqueValues = Nothing
    Set rngColumn = Nothing
    Set rngCell = Nothing
    
End Sub

I am using the code to extract data from 14 columns. Note that each column may contain multiple blank cells. The type mismtach error occurs in the following line :

 Worksheets("Sheet5").Range("A2").Resize(dicUniqueValues.Count).Value = Application.Transpose(dicUniqueValues.keys())

As suggested earlier, running the following code in the immediate window is now giving 0 as an output.

? dicUniqueValues.Count

I guess the problem is because of multiple blank cells in the columns. Is there any way to go around this ?
Your help is greatly appreciated.Thanks @Domenic.

 

[Domenic]

Blank cells are not the problem. The code ignores cells that contain either error values or blanks. The fact that dicUniqueValues.Count returns 0 means that the specified columns on the active sheet contain only error values and/or blanks. Does the active sheet contain any data, other than error values or blanks? Do you actually want to get unique values from another sheet instead?

 

[aayush_agarwal]

Hi @Domenic, thanks a lot for your help, the code seems to work fine now.