x
• Status: Solved
• Priority: Medium
• Security: Public
• Views: 230

# Number Unique Values Concatenated

I have the following data and want to ount up the number of unique thk + rad combinations.  I should end up with 4 in this example.  How can I do this?

0.118      0.125
0.118      0.18      0.136      0.125
0.118      0.125
0.394      0.125

If they were not formatted as shown above, we would have this data:
.118 .125
.118 .18
.118 .136
.118 .125
.118 .125
.394 .125
I get 4 unique values here
unique.xls
0
munch007
2 Solutions

Commented:
First, apply an advanced filter (Data>Filter> Select Unique Records Only Checkbox)

Then, use the subtotal function in your summation box. The first argument, 3, lets the subtotal function know that it is giving a "CountA" of all the visible records (database term for row).

See attached
unique.xlsx
0

Author Commented:
I cannot apply a filter to do this.  Not an option.
0

Commented:
The functionality of excel when it comes to getting distinct values is relatively limited, out of the box. You could write a short macro for this if you're up to it, unfortunately I'm too busy today. Maybe someone else will write you one. Good luck.

0

Excel VBA DeveloperCommented:
I am assuming that
1) the data is being parsed from some text file and that you can successfully import it such that the rad(x) values are in individual columns

I have attached sample VBA code that worked for me with your sample data.  It has a section commented "Import text file" which one could insert code there to import/parse the data as part of the routine, but in this instance, it is processing data already imported and inserted into columns with the labels you described.

``````Sub UniquePairs()
Dim cell As Object
Dim rng As Range
Dim c, intLastRow As Integer

' Import Text File

' Convert to Two-column range
Range("A2").Select
intLastRow = Selection.End(xlDown).Row
Range("A2", Selection.End(xlDown)).Select
Set rng = Selection
For Each cell In rng
For c = 2 To 6 'check each adjacent column
If cell.Offset(0, c).Value <> "" Then
'add value pair to last row
Range("A" & intLastRow + 1) = cell.Value
Range("B" & intLastRow + 1) = cell.Offset(0, c).Value
cell.Offset(0, c).Value = ""
intLastRow = intLastRow + 1
End If
Next c
Next cell
Range("C:G").EntireColumn.Delete
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.Offset(0, 1)).Select
), Unique:=True
Range("A:B").EntireColumn.Delete 'optional
End Sub
``````
0

Commented:
Here is my version, very similar . . .
Output is put in sheet 2 with a summary (xCounter)

Dim xArrayPos As Integer
Dim xFindDup As Integer
Dim xCounter As Integer

' Position in A2
Sheets(1).Select
Range("a2").Select

xArrayPos = 1
Do While ActiveCell.Value <> ""
For xCol = 1 To 6
' Skip Empty cells
If ActiveCell.Offset(0, xCol).Value <> "" Then
xArrayPos = xArrayPos + 1
End If
Next xCol

' Jump down one row
ActiveCell.Offset(1, 0).Select
Loop

' Remove duplicates
' Skip empty elements
If xRads(1, idx) <> "" Then
' Cycle through the rest of the elements and remove duplicate
For xFindDup = idx - 1 To 1 Step -1
' Blank out the Array element if it's a duplicate
End If
Next xFindDup

' If it survived the removal procedure, display
If xRads(1, idx) <> "" Then
End If
End If
Next idx

' output if necessary
Sheets(2).Select
Range("a2").Select
xCounter = 0
' Skip empty elements
If xRads(1, idx) <> "" Then
xCounter = xCounter + 1
' Jump down one row
ActiveCell.Offset(1, 0).Select
End If

Range("E1").Value = xCounter & " unique items found"

Next idx

End Sub
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.