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.

 

[igold]

Hi aayush_agarwal,

Welcome to the MrExcel Forum.

I have a question:

Are the unique strings you are looking for, unique to all columns, or are they unique only in the column in which they are located. Since your image did not come through perhaps you could graphically represent what your image was going to show.

Also, what are you going to do with the unique values once they have been isolated.

 

[aayush_agarwal]

Hi igold,
Thanks for your response. I am not sure as to why the image didnt come through in my thread.
You can find the image on this link: https://cdn1.imggmi.com/uploads/2019/2/24/ed0dd93f682aa5b9d2663a6d9fe17fe4-full.jpg
To answer your question, the unique strings I am looking for are unique to all the columns. Once, I isolate these unique string values to another sheet, I am going to extract numerical data corresponding to each string value and perform further calculations.
I am sorry for the mistakes in my thread, as I am new to this forum.

 

[Domenic]

Assuming that the active sheet contains the data, try...

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("C", "E", "H", "J") 'change and/or add as desired
    
    For i = LBound(varColumns) To UBound(varColumns)
        lastRow = Cells(Rows.Count, varColumns(i)).End(xlUp).Row
        Set rngColumn = Range(varColumns(i) & "5:" & varColumns(i) & lastRow)
        For Each rngCell In rngColumn
            If Len(rngCell) > 0 Then
                dicUniqueValues(rngCell.Value) = ""
            End If
        Next rngCell
    Next i
    
    Worksheets("Sheet2").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

Hope this helps!

 

[aayush_agarwal]

Hi Domenic,
Thanks a lot for your reply. I tried to run the code given by you, however i got a type mismatch error in Line :

If Len(rngCell) > 0 Then

'
Also is it possible to run the code starting from the 7th row until the last row, as the rows above the 7th contain headers which i do not require in the output.
Thanks a lot for your help.

 

[aayush_agarwal]

Hi Domenic,
I looked further into the type mismatch error 2042 and i think that i am getting this error because some cells in the columns cotain #N/A (This is because the staring values in my columns have been generated using vlookup() from some other worksheet and hence there are few #N/A values in the cells).
Is there a way to go around this ? Is it possible to modify the code such that it ignores the #N/A values present and compares all other string values.
Thanks a lot for your time.
Sorry for my mistakes, as i am a beginner to both VBA and also to this forum.

 

[Domenic]

That's no problem, in that case, try the following instead...

    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

Hope this helps!

 

[aayush_agarwal]

Hi @Domenic, thanks for your reply. The updated code solved the mismatch error in the for loop, however now i am getting a run time error 13 : tyoe mismatch error in the following line of the original code :

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

error : Identifier not recognized
It would be very helpful if you can help in resolving this error
Thanks a lot

 

[Domenic]

That's probably because no items have been added to dicUniqueValues. Try running the code again. This time, though, when the error occurs, click on Debug, and then enter the following line in the Immediate Window (Ctrl+G), and press ENTER...

? dicUniqueValues.Count

Does it in fact return 0 ?

 

[aayush_agarwal]

@Domenic, Thanks for your reply.
I ran the code as mentioned. However it returned 9.
What do you think is the probable cause for this error ?
Thanks a lot for your help.