PDA

View Full Version : How to populate array with collection?



Michelle_s
02-17-2011, 01:51 PM
Hi All,

In cells A1:A10 I have the values a,a,a,b,b,c,c,d,d,e.

I want to write only unique values to an array, i.e. a,b,c,d,e.

I know how to use a collection to do this, i.e:

Dim mycoll As Collection
Dim Rng As Range
Dim Cell As Range

On Error Resume Next
For Each Cell In Rng.Cells
mycoll.Add Cell.Value, cell.value
Next Cell

However, can someone show me how to write either:

a) Write the unique values in the collection into an array, or

b) Get unique values from the range and write these unique values into an array directly?


Thanks in anticipation :)

Michelle.

Tinbendr
02-17-2011, 02:47 PM
Your collection will be an array.

You can use the effects of the Collection error for duplicates to fill a list (or an array).

Private Sub UserForm_Initialize()
Dim mycoll As New Collection
Dim Rng As Range
Dim aCell As Range
Set Rng = Range("A1:A10")
On Error Resume Next
For Each aCell In Rng.Cells
mycoll.Add aCell.Value, aCell.Value
Debug.Print Err
If Err = 0 Then
Me.ComboBox1.AddItem aCell.Value
End If
Err.Clear
Next
End Sub

David

Frosty
02-17-2011, 03:29 PM
I'm a little unclear exactly what you want to do... are you looking for general array help? I'm not as familiar with Excel as I am with Word, but you're already populating your collection with unique values by using the resume next with the keyname property of the collection. That's not a terribly elegant solution, but it will work.

The next steps would be...

Dim i as Integer
dim aryMyArray() as String
'I'm assuming you're using a string array, but that assumption
'can get you into trouble if your cells are explicitly numbers, I think
For i = 1 to myColl.Count
ReDim Preserve aryMyArray(i) As String
aryMyArray(i) = myColl(i)
Next


I'm not a fan of using New in the declarative statement, since although you *can* do it, if your variable loses scope for some reason during the procedure, you'll spend time troubleshooting in the wrong area (New in the declarative statement will create a new instance whenever you need one).

Instead it's good practice to do the following two steps:
Dim myCol as Collection
Set myCol = New Collection

That said, there are other ways of using the SQL concept of DISTINCT from within VBA (and I think that functionality is a little more accessible from Excel than Word), but that could be a longer discussion.

Shred Dude
02-17-2011, 04:11 PM
If your example is merely a hypothetical you're looking to scale to a larger solution, you might want to read up on the Range object's AdvancedFilter method. It will save you all the looping.

If your source values were in a single column instead of a single row you could do soemthing like this to get a range object populated with only the unique values, which you could then assign to an array...

Dim rngOriginal As Excel.Range
Dim rngUnique As Excel.Range
Dim arrUnique() As Variant

Set rngOriginal = Range("a1:a10")
Set rngUnique = Range("b1")

rngOriginal.AdvancedFilter Action:=xlFilterCopy, copytorange:=rngUnique, _
unique:=True

Set rngUnique = rngUnique.Resize(Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row, 1)

ReDim arrUnique(rngUnique.Rows.Count)
arrUnique = rngUnique.Value


There would be several other ways to achieve the same end with Advanced Filters. Depending on your real world situation, you'll probably have some options.

mikerickson
02-17-2011, 08:07 PM
Dim pointer as Long
Dim oneCell as Range
Dim myArray as Variant

With Range("A1:A10")
ReDim myArray(1 to .Cells.Count)

For each oneCell in .Cells
If Not IsNumeric(Application.Match(CStr(oneCell.Value), myArray, 0)) Then
pointer = pointer + 1
myArray(pointer) = CStr(oneCell.Value)
End If
Next oneCell

ReDim Preserve myArray(1 to pointer)
End With

Kenneth Hobs
02-17-2011, 08:45 PM
For a dictionary example, see my post: http://www.vbaexpress.com/forum/showthread.php?t=24917

Michelle_s
02-17-2011, 11:23 PM
Hi Guys, thanks so much for taking the time to reply.

Tinbendr, thanks again. I wasn't sure if a collection had the same properties as an array - i.e. so that I can loop through the collection in the same manner I would an array.


Frosty - Your first reply was the kind of approach I was thinking about. I've got a column with about 8000 product IDs in and need to get the unique values this column that have been duplicated. I need to the perform some recursive actions. I.e. one ID might appear 8 times - I need to loop through all the rows with that ID and rationalise these into one row that takes different parts of data from each of the previous rows. Hope that makes sense! :s


ShredDude, that's an interesting approach. I didn't know you could write the results of an autofilter into an array. I appreciate how this would save looping. Thanks for pointing this out.


Mike, that's interesting to. I didn't know how to strip out and write unique values directly to an array. Can I clarify something:

If Not IsNumeric(Application.Match(CStr(oneCell.Value), myArray, 0))

Is this saying that if I can't match the value of the current cell in the range then it adds that values to the array. if it can match it, it does nothing?


Kenneth - I've never used the data dictionary! Interesting. I guess I could just substitute the fixed values in that array for for all the cells in a range simply using aFirstArray() = myws.range("A1:8000")?


I assume that ShredDude's approach will be quickest out of all these excellent suggestions? Part of me wants to go with that, part of me wants to play around with all this lovely vba!!

Thanks so much guys.

Michelle.

Tinbendr
02-18-2011, 02:26 AM
Tinbendr, thanks again. I wasn't sure if a collection had the same properties as an array - i.e. so that I can loop through the collection in the same manner I would an array.Yes you can


I've got a column with about 8000 product IDs in and need to get the unique values this column that have been duplicated.
But since you have so many, the dictionary object (http://msdn.microsoft.com/en-us/library/x4k5wbx4%28v=vs.85%29.aspx) might be better choice since it is a bit more powerful.

But there are some other very good options above.

Michelle_s
02-18-2011, 04:07 AM
Thanks for the info TinBendr!

I've another question if you don't mind. Could someone teach me how to, presumably using an array like MikeRickson's approach, to add a second dimension to the array to count the number of times that that value occurs in the the range?

Thanks! :)



Dim pointer as Long
Dim oneCell as Range
Dim myArray as Variant

With Range("A1:A10")
ReDim myArray(1 to .Cells.Count)

For each oneCell in .Cells
If Not IsNumeric(Application.Match(CStr(oneCell.Value), myArray, 0)) Then
pointer = pointer + 1
myArray(pointer) = CStr(oneCell.Value)
End If
Next oneCell

ReDim Preserve myArray(1 to pointer)
End With

mikerickson
02-18-2011, 07:14 AM
If Not IsNumeric(Application.Match(CStr(oneCell.Value), myArray, 0)) Then
is saying
If Not (new_value is in myArray) Then

mikerickson
02-18-2011, 07:17 AM
This will return an n row X 2 column array
Dim pointer As Long
Dim oneCell As Range
Dim myArray As Variant

With Range("A1:A10")
ReDim myArray(1 to 2, 1 To .Cells.Count)

For Each oneCell In .Cells
If Not IsNumeric(Application.Match(CStr(oneCell.Value), myArray, 0)) Then
pointer = pointer + 1
myArray(1, pointer) = CStr(oneCell.Value)
myArray(2, pointer) = Application.CountIf(.Cells, myArray(1, pointer))
End If
Next oneCell
End With

ReDim Preserve myArray(1 to 2, 1 To pointer)

myArray = Application.Transpose(myArray)

Shred Dude
02-18-2011, 08:11 AM
To determine the number of occurences of a value in column A, you could just put a Countif formula in column B. If your values are in A1:A8000 put this formula in B1, entered as an array formula ( CTRL-SHIFT-ENTER) and copy it down to B8000

=SUM(COUNTIF($A$1:$A$8000,"=" & A1))

That will tell you how may times the value in column A appears in the entire range. This method will save you all the looping. Let Excel do it for you and then quickly pull the results into an array if that's what you need.

Michelle_s
02-18-2011, 11:34 AM
Thanks Mike, not as complex as I thought - presumed I would have to iterate through the first dimension. Didn't realise I could do it at the same time.

ShredDude, thanks! I'm OK with formulas. Always good to have another perspective tho.

Thanks all for your input. Really good of you. :)

Frosty
02-18-2011, 11:53 AM
Just a quick follow up on a concept:
Collections are similar but not the same as arrays. If you're just grabbing the info, you can loop through them in similar ways (with the collection added benefit of unique Key Names, allowing you to "jump" right to a particular item).

But if you're looping through and adding or deleting items (i.e., changing the count) you can run into issues. Whereas you have to really mess with an array to change its essential structure with ReDim Preserve etc type stuff, Collections are a lot easier to adjust. Consider the following


Sub Test()
Dim x As New Collection
Dim i As Integer

For i = 1 To 10
x.Add i, CStr(i)
Next

For i = 1 To x.count
x.Remove i
Next

End Sub

And you'll see the issue... because the counter (i) doesn't know you're pulling the rug out from under it as it increments, you'll end up deleting every other one, and getting an error "halfway" through your second loop. Depending on the scenario, you may need to iterate through a collection in reverse order if you are removing members, or use do loops, or something else.

Just something to add to the conversation, as the excel experts seem to have covered the particulars of your issue.

Michelle_s
02-18-2011, 12:02 PM
Hi Mike,

Spoke to soon - the array now contains duplicated records with a count for each record rather than a count for just the unique record. Hope that makes sense. Could you point me in the right direction, please?

Michelle_s
02-18-2011, 12:07 PM
Hi Frosty,

That's interesting, thanks. I know what a collection is but didn't really know what the difference between a collection and an array was for my purpose. I figured they could do the same thing. Interesting point about how you can, as you say, pull the rug out from under it but still keep the loop intact. Seems a little less robust than an array but I guess you could do the same to an array if you really wanted to! Thanks Frosty! :)

GTO
02-18-2011, 02:19 PM
Hi All,

I did not get to test most of the suggestions (I hate it when work is too busy and interferes with my learning!), but was thinking that COUNTIF might be slower in a larger range.

To setup, in a blank/new workbook:

Sub SetUp()
Sheet1.Range("A2:A10000").FormulaArray = "=ROUND(RAND()*1200,0)"
Sheet1.Range("A2:A10000").Value = Sheet1.Range("A2:A10000").Value
End Sub

A slightly different approach with Dictionary and COUNTIF:

Sub exaDicAndCountif()
Dim _
DIC As Object, _
rngIDs As Range, _
aryRange As Variant, _
aryOutput As Variant, _
Tmp As Variant, _
i As Long, _
n As Long

Dim Stopwatch As Double

Stopwatch = Timer

Set DIC = CreateObject("Scripting.Dictionary")

Set rngIDs = Sheet1.Range("A1:A10000")
aryRange = rngIDs.Value

For i = 1 To UBound(aryRange, 1)
If Not aryRange(i, 1) = vbNullString And Not aryRange(i, 1) = 0 Then
DIC.Item(aryRange(i, 1)) = Application.CountIf(rngIDs, aryRange(i, 1))
End If
Next

If DIC.Exists(vbNullString) Then DIC.Remove (vbNullString)
If DIC.Exists(0) Then DIC.Remove (0)

ReDim aryOutput(1 To DIC.Count, 1 To 2)

For n = 1 To 2
If n = 1 Then Tmp = DIC.Keys Else Tmp = DIC.Items
For i = 1 To DIC.Count
aryOutput(i, n) = Tmp(i - 1)
Next
Next

Stopwatch = Timer - Stopwatch

Debug.Print "Dictionary & Countif: " & Stopwatch

Sheet1.Range("F2").Resize(UBound(aryOutput, 1), 2).Value = aryOutput
End Sub


Then, with Dictionary and keeping a running count by adding to ea key's item, when we find the same key:

Sub exaDicAndKeepCount()
Dim _
DIC As Object, _
rngIDs As Range, _
aryRange As Variant, _
aryOutput As Variant, _
Tmp As Variant, _
i As Long, _
n As Long

Dim Stopwatch As Double

Stopwatch = Timer

Set DIC = CreateObject("Scripting.Dictionary")

Set rngIDs = Sheet1.Range("A1:A10000")
aryRange = rngIDs.Value

For i = 1 To UBound(aryRange, 1)
If Not aryRange(i, 1) = vbNullString And Not aryRange(i, 1) = 0 Then
DIC.Item(aryRange(i, 1)) = DIC.Item(aryRange(i, 1)) + 1
End If
Next

If DIC.Exists(vbNullString) Then DIC.Remove (vbNullString)
If DIC.Exists(0) Then DIC.Remove (0)

ReDim aryOutput(1 To DIC.Count, 1 To 2)
For n = 1 To 2
If n = 1 Then Tmp = DIC.Keys Else Tmp = DIC.Items
For i = 1 To DIC.Count
aryOutput(i, n) = Tmp(i - 1)
Next
Next

Stopwatch = Timer - Stopwatch

Debug.Print "Dictionary & KeepCount: " & Stopwatch

Sheet1.Range("C2").Resize(UBound(aryOutput, 1), 2).Value = aryOutput
End Sub



By timing as shown, I got:
MATCH & Countif: 57.4375
Dictionary & Countif: 18.34375
Dictionary & KeepCount: 0.046875



@Mike:
A Howdy of course, it's been a while. I did catch the OP's comment as to currently not just returning uniques, but I tested 'as-is' just to see how much Match would effect.

@Michelle:
I hope I didn't miss anything, a bit past when I should be sacked out...

Hope that helps,

Mark

GTO
02-18-2011, 02:28 PM
ACK!

I forgot to mention that I did clear a few cells and replace a few random vals with zeroes. Seems to handle...

Michelle_s
02-18-2011, 03:05 PM
Hi GTO!

I know what you mean! It's great doing stuff like this, especially when you're really learning from it! I'm the same at work...it's frustrating when I have to do mundane tasks when I could be doing learning stuff like this! :)

I'm sure you were interested in it yourself, but thanks for taking the time to test these different approaches. It REALLY shows the impact that different approaches have! I think that if I wasn't totally unfamiliar with the data dictionary approach (never heard of it until now) then I would definitely have to go with this solution. It's actually a little overwhelming just how many times quicker your dictionary + keepcount approach is compared to match and countif!!! (Not that I think match and countif I wrong or bad though - thanks Mike for your help)

Thanks for your input GTO, it's really added some perspective.

Michelle.

mikerickson
02-19-2011, 08:26 AM
My mistake, I forgot that MATCH only works on 1-D arrays. This should do what you want.
Dim pointer As Long
Dim oneCell As Range
Dim myArray As Variant, tempArray As Variant

With Range("A1:A10")
ReDim myArray(1 To 2, 1 To .Cells.Count)
ReDim tempArray(1 To .Cells.Count)

For Each oneCell In .Cells
If Not IsNumeric(Application.Match(CStr(oneCell.Value), tempArray, 0)) Then
pointer = pointer + 1
tempArray(pointer) = CStr(oneCell.Value)
myArray(1, pointer) = CStr(oneCell.Value)
myArray(2, pointer) = Application.CountIf(.Cells, myArray(1, pointer))
End If
Next oneCell

End With

If pointer = 1 Then
tempArray = myArray
ReDim myArray(1 To 1, 1 To 2)
myArray(1, 1) = tempArray(1, 1)
myArray(1, 2) = tempArray(2, 1)
Else
ReDim Preserve myArray(1 To 2, 1 To pointer)
myArray = Application.Transpose(myArray)
End If