PDA

View Full Version : Solved: Unique find with VBA



gsouza
11-17-2005, 05:08 AM
Hello ladies and gentlemen :hi: , is it possible to do a unique find on more than one column? Prehaps highlight three or more columns of data and have only the unique data be placed in an empty column. How about even if the highlighted columns of data have empty cells within it. If anybody can help it would be greatly appreciated as of all your help in the past has been greatly appreciated.
Thank you.

Killian
11-17-2005, 06:18 AM
Hello there :hi:

The Find method applies to a Range, so if you can just use it on the selection (which returns a range if cells are selected).
Empty cells won't matter to Find, but I assume by the phrase "unique find", you want to take each value in the selection and test to see if it has a duplicate somewhere in else in the selection. This will involve a For... Each cell in the selection, and if you have whole columns selected, that's a LOT of cells - time consuming.
You can bring this down by modifying the range for the find with SpecialCells, but for the purposes of this example, that will assume the cell vaules are constantsDim c As Range
Dim FoundItem As Range

For Each c In Selection.SpecialCells(xlCellTypeConstants)
With Selection
Set FoundItem = Nothing
Set FoundItem = .Find(c.Value, LookIn:=xlValues, _
LookAt:=xlWhole)
If FoundItem.Address = c.Address Then
Set FoundItem = Nothing
Set FoundItem = Selection.FindNext(c)
End If
If FoundItem.Address = c.Address Then
'show the unique values in the immediate window
Debug.Print "Unique value " & c.Value & _
" at " & c.Address
End If
End With
Next

gsouza
11-17-2005, 09:03 AM
I attached file to explain more what I need. I don't think I explained myself well the first time. Sorry for that.

Killian
11-17-2005, 09:21 AM
I looked at the file and I still don't understand... it could easily be me being stupid. :doh:
It seems like you want, for each row, the blue cell in col E to be poupalted with something, based on what is in cols A to C for the same row...
but I'm not sure what... :dunno

I've attached the file again with a new comment :thumb

gsouza
11-17-2005, 09:46 AM
I think it is like this, I think I started explaining things to early in the morning. Let me try this again. LOL. Its so simple I don't know why I can't explain it, but here I go again.

In a range say range("a1:d12") or any range I want to pull out all the unique values from that range without any blank cells and put those unique values in a list in one column to the right someplace say in column F.

Thanks for being patient


I hope this helps, I am laughing my ass off because its so simple, I feel so dumb.

mvidas
11-17-2005, 09:54 AM
Hi gsouza,

You could have a function that takes the unique entries from a range, and returns the unique values in an array. Then just loop through the array and enter the unique values from that:Sub gsouzaExample()
Dim AnArray() As String, i As Long
AnArray = GetUniqueEntries(Range("A1:D12"))
If Len(AnArray(0)) > 0 Then
For i = 0 To UBound(AnArray)
Range("F1").Offset(i, 0) = AnArray(i)
Next
End If
End Sub

Function GetUniqueEntries(ByVal ARange As Range) As String()
Dim TempArr() As String, Cnt As Long, CLL As Range, i As Long
Cnt = 0
i = 0
ReDim TempArr(0)
Set ARange = Intersect(ARange, ARange.Parent.UsedRange)
If Not ARange Is Nothing Then
For Each CLL In ARange.Cells
If Len(Trim(CLL.Text)) > 0 Then
For i = 0 To Cnt - 1
If TempArr(i) = CLL.Text Then Exit For
Next i
If i = Cnt Then
ReDim Preserve TempArr(Cnt)
TempArr(Cnt) = CLL.Text
Cnt = Cnt + 1
End If
End If
Next
End If
GetUniqueEntries = TempArr
End FunctionMatt

gsouza
11-17-2005, 09:59 AM
Oh my God that is it, thank you both, sorry Killian for being so distorted with my explaination. You both have a good day. It works great.

mvidas
11-17-2005, 10:04 AM
Glad to help! You also might want to take a look at brettdj's The Duplicate Master, a free add-in that does exactly this and more, very easy to use.
http://members.iinet.net.au/~brettdj/

Newly updated too, as of this month!

gsouza
11-18-2005, 02:22 PM
Okay, I will check out the addin.