Solved: unique items into a 2d array

Hello,

I have a worksheet which has a column with codes that are duplicated.

I want to extract unique codes and put them into an array.

I then want to re-loop through the worksheet and look at a different column.

For each item in the array I want to check if this row has that item and then assign the number value to the 2nd dimension of the array.

I am going to use this 2d array to compare to another worksheet.

In the other worksheet I will compare the codes in the first dimension of the array (ie say it finds it in row 12), compare the number value in the corresponding second dimension to the value in another cell of row 12 and deduct the value from the second dimension of the array (i.e. it will be a reducing balance.

I hope this doesnt sound too complicated and will appreciate help

Sorry if this sounds rushed but I am in an internet cafe and the guy next to me really smells so I need to get out of here!!!!

Hi phil,
It sounds like you have your logic down pat, so it's just an implementation issue. Did you need help with some part?

Yeah, sounds like you have a pretty good handle on what you want to do.

A little advice, though: many things that are easy to do with a worksheet are difficult to do with an array, the main example being Sorting. Therefore, you should get all of your sorting done BEFORE you fill the array.

Here is a chunk of code I use to remove duplicate entries before feeding data into an array:

[vba] 'sort the schools=
Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlNo

'Delete the duplicate rows
Cells(1, 1).Select
Do Until ActiveCell.Value = ""
If ActiveCell.Offset(1, 0).Value = ActiveCell.Value Then
Rows(ActiveCell.Row).Delete shift:=xlUp
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Cells(1, 1).Select[/vba]

Hope that helps!

Hi guys,

Thanks for your replies.

In response to the first reply - I need help with the whole thing!!! Your expert advice would be appreciated

Regarding the second response. I agree, and have some things much harder in code that would be easy in the spreadsheet i.e. countif. Your code looked interesting but the problem is I cant delete any rows as I need other information from the duplicate rows (i.e. the amount) so I just need to scroll down the column and pick up unique items from one column.

I will then use these to scroll down again and get running totals of the amounts from the rows

Hope this makes sense - its Friday, I've had a long week!!!

Hello,
I would say then you need two bits of information. How to get the info into the array, and how to work with the array once you have it. I have posted those examples. I realize they may seem a bit complex if you are just starting out, so I tried to explain them in the comments as best I could at 2:30 AM :D. However if anything seems unclear or you just hit a wall. Post back! :)

[VBA]Option Explicit
Public Sub Test()
'To Test:
'1.) Create a dmall range of test data with some duplicates.
'2.) Highlight/Select said range.
'3.) From the "View Menu" select "Locals" so you can watch what is occuring.
'4.) When you run macro, select "Step Into" for Line By Line Execution.
'5.) Press F8 to advance to the next line, f9 to set a break point, and
' F5 to continue to that break point.
Dim strVal() As String
'This will load range to a string array.
strVal = LoadArrayToRange(Excel.Selection)
strVal = MakeUniqueArray(strVal, 1, vbTextCompare)

End Sub

Private Function LoadArrayToRange(inputRange As Excel.Range) As String()
'Note it is possible to load a range to a *Variant* array
'with the MyArray = Range.Value syntax, but you will hit
'memory probelms over large ranges, and variant datatype
'is SLOW. This method will allow you to work with the
'much faster string arrays.
Dim cll As Excel.Range
'Note that I did not hard code the dimensions of the array (ex:
'Dim strVal(1 to 10, 1 to 2) As String) when you omit the
'dimensions in a declaration, you must set them at runtime.
'This is called a "Dynamic Array".
Dim strVal() As String
'This is the aforementioned redimensioning:
ReDim strVal(inputRange.Row To inputRange.Rows.Count, inputRange.Column To inputRange.Columns.Count)
For Each cll In inputRange.Cells
strVal(cll.Row, cll.Column) = cll.Value
Next
LoadArrayToRange = strVal
End Function

Private Function MakeUniqueArray(ByRef inputArray() As String, _
ByRef examineDimension As Long, _
Optional ByRef compare As VbCompareMethod = _
VbCompareMethod.vbBinaryCompare) As String()
Const lngMatch_c As Long = 0
Const lngOffset1_c As Long = 1
Dim strOtptArr() As String 'Output Arrau
Dim lngLenBs() As Long 'Stores the byte-length of a value.
Dim lngLwrBnd As Long 'Lower Bound
Dim lngUprBnd1 As Long 'Input Array Upper Bound
Dim lngUprBnd2 As Long 'Output Array Upper Bound
Dim lngIndx1 As Long 'Input Array Index
Dim lngIndx2 As Long 'Output Array Index
Dim lngValLenB As Long 'Current item's byte-length (# of characters X2)
lngLwrBnd = LBound(inputArray, examineDimension)
lngUprBnd1 = UBound(inputArray, examineDimension)
ReDim strOtptArr(lngLwrBnd To lngUprBnd1)
ReDim lngLenBs(lngLwrBnd To lngUprBnd1)
lngUprBnd2 = lngLwrBnd
For lngIndx1 = lngLwrBnd To lngUprBnd1
'LenB is used instead of Len as it is faster
lngValLenB = LenB(inputArray(lngIndx1, examineDimension))
For lngIndx2 = lngLwrBnd To lngUprBnd2
'StrComp is slow, and can be avoided in most cases by doing the
'very fast comparison of the text length. Obviously if the lengths
'don't match then the text does not match.
If lngValLenB = lngLenBs(lngIndx2) Then
If StrComp(inputArray(lngIndx1, examineDimension), strOtptArr(lngIndx2), compare) = lngMatch_c Then
'Match Found, no need to proceed.
Exit For
End If
End If
Next
'If a match was found in the Output Array then the loop
'would have exited early and the index would be less than
'the upper bound. So if the index is greater than the
'upperbound than the item does not yet exist in the
'output array and should be added.
If lngIndx2 > lngUprBnd2 Then
'Store item in output array.
strOtptArr(lngUprBnd2) = inputArray(lngIndx1, examineDimension)
'Store Item's length for further comparisons to avoided repeated
'function calls to LenB:
lngLenBs(lngUprBnd2) = lngValLenB
'Increment the upper bound:
lngUprBnd2 = lngUprBnd2 + lngOffset1_c
End If
Next
'If duplicates were found, the Output array will be smaller than
'the input array. However the output array was originally sized
'to the input array. (To prevent multiple redims.) This will
'resize the output array to remove the empty items.
lngUprBnd2 = lngUprBnd2 - lngOffset1_c
If lngUprBnd1 < lngUprBnd2 Then
ReDim Preserve strOtptArr(lngLwrBnd To (lngUprBnd2 - lngOffset1_c))
End If
'Note the output is only then dimension that was examined. So if you load
'the output back into the input array (as I did in the example). The
'input array will be reduced to only a unique array of the examined column.
'This may or may not be desired behavior, so be aware that it occurs.
MakeUniqueArray = strOtptArr
End Function
[/VBA]