Need to Return Unique Values from Range of Cells in Excel 1

[KellyStee]

I have a list of values in the range H:H, J:J, L:L and from these values
I want to create a list in column A (A:A) of only the unique values found in the other three columns. For example:

H J L
__________________________
Apple Orange Grape
Pear Lemon Apple
Grape Orange Lime

so column A should contain:

A
_______________
Apple
Pear
Grape
Orange
Lemon
Lime

What I have tried so far is:
To take each individual cell (through 2500 rows, since I don't know how to loop until it picks up every value - I just picked a very large number of rows) in columns H, J, and L and compare it to each cell in A (using another loop through A1:A2500), but this takes entirely too long (see code below).

For rwIndex = 4 To 2500
For rwIndex1 = 4 To 2500
If Worksheets("Sheet1&quot.Cells(rwIndex, 8).Value = Worksheets("Sheet1&quot.Cells(rwIndex1, 1).Value Then
Worksheets("Sheet1&quot.Cells(rwIndex, 1).Value = Worksheets("Sheet1&quot.Cells(rwIndex, 8).Value
End If
Next rwIndex1
Next rwIndex

I've also tried using the "instr" function with String1 = Range("A1:A2500&quot.Select (although I thought I wanted to use .Value here, but it tells me there's a "Type Mismatch&quot and String2 = (rwIndex, 8).Value and if the Instr result = 0 then copy the value in column H to column A (see code below). The problem with this code, though, is that the Instr statement ALWAYS equals 0; even when I intend for it not too.

For rwIndex = 4 To 2500
If InStr(Worksheets("Sheet1&quot.Range
("A1:A2500&quot.Select, Worksheets("Sheet1&quot.Cells (rwIndex, 8).Value) = 0 Then
Worksheets("Sheet1&quot.Cells(rwIndex, 1).Value = Worksheets("Sheet1&quot.Cells(rwIndex, 8).Value
End If
Next rwIndex

So, it seems my task was fairly simple when I started the whole project, but I feel I may be making the code much for complex than need be. Am I missing the boat here?

Please help!!
Thanks!
Kelly

 

[Klopper]

Hi Kelly

I think the simplest method would be to build up an array variable:
1. loop through the data which contains duplicates,
2. if the value contained in a the cell is not already contained in the array then
3. add the data as another item to the array variable.
4. The array variable can then be used to populate the values in column A.

Take a look at thread thread222-68291 for some example code.

HTH
Klopper

 

[bryanbayfield]

sub take_unique()
dim store() as string
for i = 1 to 3
set ri = range("h1",range("h1").end(xldown)).offset(0,(i-1)*2)
ni = ri.cells.count
next i
set multirange = Union(r1,r2,r3)
n = multirange.cells.count
ReDim store(n1)
for j = 1 to n1
store(j) = r1.cells(j,1).value
next
redim Preserve store(n1+n2)
for k = 1 to n2
store(k + n1) = r2.cells.value
next
redim Preserve store(n)
for l = 1 to n3
store(l + n1 + n2) = r3.cells.value
next
activesheet.columns(1).insert
for m = 1 to n
range("a1").offset(m-1,0).value = m
range("a1").offset(m-1,1).value = store(m)
next m
range("a1",range("b1").end(xldown)).sort key1:=activesheet.range("b1")
for p = 1 to n - 1
if cells(p+1,2).value = cells(p,2).value then
range("a1:b1").offset(p,0).delete(xlshiftup)
endif
next p
range("a1",range("b1").end(xldown)).sort key1:=activesheet.range("a1")
activesheet.columns(1).delete

I don't have time to check this but it should do what you want. I know it looks clunky but I'd say it'd probably execute quite quickly due to teh use of arrays and loops.

Cheers.

Bryan SuperBry!

 

[nath]

The quickest is probably to take a collection. The code below runs in no time for 2500 rows and 3 columns.

The idea is the following: you go through each element and adds it to a collection. You use the name of the element as an index. If the element has already been added to the collection, the code will send an error message. Instead of allowing the error message you make the run go to the next element if it bugs (this is achieved with "On Error Resume Next&quot. WHen it has finished you copy all the elements on the spreadsheet.

Try the following code. It should work with small adjustments.

Also you do not need to select a cell each time you want to take its value. It is very time concuming to do so. The code below doesn't select the cell.

The code:

Dim myColl As Collection
Dim r As Long, c As Long
Dim val As String
Dim x As Variant

Set myColl = New Collection

With ThisWorkbook.Worksheets("Sheet1")
    For c = 8 To 10 'corresponds to columns H to L, change this if appropriate
        For r = 1 To 2500
            val = Cells(r, c).Value
            On Error Resume Next
            Call myColl.Add(val, CStr(val))
            On Error GoTo 0
        Next r
    Next c

    r = 1
    For Each x In myColl
        Cells(r, 2).Value = x
        r = r + 1
    Next x
End With
[\code]


Hope this helps,

Nath

 

[DaleWatson123321]

Kelly,

VBA used INDEPENDENTLY from the numberous "built-in" functions of Excel is always possible, BUT, it seems to me to often be the "tedious and time-consuming" option.

Excel's built-in functions, IF used, can save considerable time and effort. The following VBA code - which utilizes the database functionality of Excel, I believe provides one reasonable example...

The model I created involves having used a small number of Range Names. The code is provided below, but if you have any difficulty because of the use of the Range Names, it is probably preferable for you to send me an email, and I'll return the (working) example file to you by return email.

Here's the code...

Dim data As Range
Dim col1 As Range
Dim col2 As Range
Dim col3 As Range
Dim combdata As Range


Sub Extract_Unique()
Application.ScreenUpdating = False
Clear_Data 'clears existing data
Merge_Data ' merges data from the 3 columns
Extract_Data ' extracts UNIQUE records
Application.ScreenUpdating = True
Application.Goto Reference:="out"
Application.Goto Reference:="R1C1"
End Sub

Sub Clear_Data()
Worksheets("Combined_data&quot.Select
Range("combdata&quot.Select
Selection.ClearContents
End Sub

Sub Merge_Data()
Application.Goto Reference:="combined"
ActiveCell.Offset(1, 0).Select
Range("col1&quot.Copy
ActiveSheet.Paste
Go_Last_Row
Range("col2&quot.Copy
ActiveSheet.Paste
Go_Last_Row
Range("col3&quot.Copy
ActiveSheet.Paste
Application.Goto Reference:="R1C1"
End Sub

Sub Extract_Data()
Range("data&quot.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:="crit", _
CopyToRange:=Range("out&quot, _
Unique:=True
End Sub

Sub Go_Last_Row() 'determines next blank row
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(3, 0).Select
ActiveCell.End(xlToLeft).Select
ActiveCell.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
End Sub


Please don't hesitate to ask for the example file if you have any doubt about the effectiveness of this option.

Please email to BOTH addresses, especially if responding before I return to work on MONDAY.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca
or nd.watson@shaw.ca (home)

 

[DaleWatson123321]

Kelly,

I see you're logged in today.

...curious to know how you've made out...

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[SkipVought]

Hi,
One other improvement can be made to nath's code. By defining a range, the cells within the range can be handled like a collection.

    For Each cell In Cells(1, 8).CurrentRegion
' Cells(1, 8).CurrentRegion defines the entire data range
        val = cell.Value
' the rest of nath's code goes here
   Next cell

This eliminates the need to know how many columns and rows. You hust have to be able to referr to a cell within you data table -- hence Cells(1,8). This code will sequence through each cell in the data range. Skip,
metzgsk@voughtaircraft.com

 

[DaleWatson123321]

Kelly,

My apologies if you are REALLY BUSY, but "the guys" who have contributed postings to help you out with your problem are probably getting a little anxious to find out "WHO THE WINNER IS".

I probably speak for the others in suggesting that in helping to resolve problems, we also enjoy each other's "jousting" with our "competitive solutions".

In my case, I have a "heavy-duty" background in using the "built-in" functions of Excel (and Lotus previously), and have found that these built-in functions can be used in conjunction with VBA and by doing so, the result is often a FAR MORE EFFECTIVE solution. This is usually because it EXECUTES MUCH FASTER than using pure VBA, as well as it generally being easier to produce the code.

I'm therefore keenly interested in you getting your hands on my example file, so you can "see for yourself". As mentioned, just email me and I'll return the file.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[KellyStee]

Ok, ok!! ) I am busy, but that's no excuse and I understand that you would be curious as to how helpful you were. I had trouble following bryanbayfield's answer (no offense, Bryan, I just haven't had the time to sit down and go through it but I definitely will soon just to further my knowledge) and then Nath's answer popped up and it made perfect sense to me and did exactly as I wanted and I went with it. I already uderstood most of the code and just had to read up on collections to figure out what he was doing. It was after I finished the project before I saw Dale's solution and I haven't responded to this entire thread because I was hoping to go through Dale's code to see how he put a different spin on resolving the issue. So I have yet to thoroughly understand Dale's solution mostly because I haven't had time to play with it (which is why I haven't responded in a week!). I only know that Nath's answer worked fine.
By the way, I didn't expect to get so much help, but THANK YOU so much!!! I'm just now getting the hang of VB and most of it I have learned through this board! Everyone is always quick to respond and it's incredibly helpful. I should respond with my comments much sooner from now on. I apologize for that and try harder. If you have the time to suggest a solution, I should have the time to try it out and respond to it! I'll work on that!

Thanks again!
Kelly

 

[KellyStee]

So, not to shoot you down, Dale, but I just haven't had time to look through your solution. I'll e-mail you with comments in the next few days after I read through it. Deal? )

Kelly

 

[DaleWatson123321]

Kelly,

THANKS for the (elaborate) response. You certainly "made up" for lost time !!!

The "important" aspect here is that you WERE able to resolve your problem with the "helping hand" of Tek-Tips contributors.

Congratulations to "Nath" for his contribution. I too will spend time in reviewing his code, and learning from it, as I’m also "on the learning curve" with VB. Permit me to give him a STAR, but don’t let that stop you from also showing your appreciation with a STAR.

I’m pleased that you’ll be emailing me with your comments. Because you’ve been busy, however, I had hoped to "save you a bit of time" by being able to email the file FIRST. This could then make it EASIER for you to understand the code as it relates to the example file.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca