-3

I need a function that takes a n*2 input array and produces n*2 output array that its first column elements are unique values from the first column of input array and second column elements are summations of numbers correspondent to each of these unique values. 

Sub test()
Dim arm(11, 1) As Variant
Dim tempar() As Variant
ReDim tempar(0 To UBound(arm, 1), 0 To UBound(arm, 2)) As Variant

arm(0, 0) = "banana"
arm(1, 0) = "banana"
arm(2, 0) = "banana"
arm(3, 0) = "apple"
arm(4, 0) = "apple"
arm(5, 0) = "banana"
arm(6, 0) = "cucumber"
arm(7, 0) = "cucumber"
arm(8, 0) = "cucumber"
arm(9, 0) = "apple"
arm(10, 0) = "cucumber"
arm(11, 0) = "a"

arm(0, 1) = 5
arm(1, 1) = 4
arm(2, 1) = 3
arm(3, 1) = 2
arm(4, 1) = 5
arm(5, 1) = 3
arm(6, 1) = 2
arm(7, 1) = 4
arm(8, 1) = 5
arm(9, 1) = 1
arm(10, 1) = 1
arm(11, 1) = 3

tempar() = unqfiladv(arm)

End Sub

resulte array must be :

banana 15
apple 8
cucumber 12
a 3

user7181718
  • 11
  • 5
  • i think you mean n*2 becomes m * 2 (or some other letter) to indicate first dimension actually can change in size? – QHarr Jan 20 '18 at 20:19
  • See here for retrieving key and values from dict https://stackoverflow.com/questions/21432222/can-i-loop-through-key-value-pairs-in-a-vba-collection/21433046. Note that there are limitations on size that can be tranposed. – QHarr Jan 20 '18 at 20:31
  • create your second array with the same dimensions as the first, loop the first array adding to a dictionary e.g. banana , 1 (if exists add to the value associated with the key i.e. current value+ new value). Transpose the array so 2nd dim becomes 1st. Then redim the second array's second dimension to the count of the dict keys, re-transpose the array, then loop the dictionary emptying into the array. See here for retrieving key and values from dict stackoverflow.com/questions/21432222/…. Note that there are limitations on size that can be tranposed. – QHarr Jan 20 '18 at 20:51
  • easier alternative might be to consolidate them http://www.excel-easy.com/examples/consolidate.html – Slai Jan 20 '18 at 22:10

1 Answers1

0

Here is an example of what I was describing.

Loop the first array and add the fruit and the value to a dictionary. This will ensure unique fruit names, as used as key, and the values can be added by simply adding to the existing value, if the key (fruit) already exists in the dictionary, or adding in the normal fashion otherwise.

Transpose the array to allow for swopping the dimensions around (as you can only resize the second dimension. There is a restriction on how many items this can be performed with using Transpose).

You should really separate this out into separate function/procedures calls, for example, adding items to a dictionary could be its own function. The retrieval of the dictionary key and value is as per @Peter Albert.

Option Explicit

Sub Test()

Dim arr1(0 to 5, 0 to 1)
Dim arr2()

arr1(0,0) = "Banana"
arr1(1,0) = "Banana"
arr1(2,0) = "Apple"
arr1(3,0) = "Banana"
arr1(4,0) = "Orange"
arr1(5,0) = "Orange"

arr1(0,1) = 1
arr1(1,1) = 2
arr1(2,1) = 3
arr1(3,1) = 4
arr1(4,1) = 5
arr1(5,1) = 6

Dim fruitDict As New Scripting.Dictionary 'required reference to MS Scripting Runtime

Dim i as Long

For i = LBound(arr1,1) to UBound(arr1,1)

    If fruitDict.Exists(arr1(i,0)) Then

        fruitDict(arr1(i,0)) = fruitDict(arr1(i,0)) + arr1(i,1)

    Else

       fruitDict.Add arr1(i,0) , arr1(i,1)

    End If

Next i

ReDim arr2(0 to 1, 0 to FruitDict.Count - 1)

arr2 = Application.WorksheetFunction.Transpose(arr2)

Dim key As Variant
Dim counter As Long
counter = 1

For Each key in fruitDict.Keys

    arr2(counter,1) = key
    arr2(counter,2) = fruitDict(key)
    counter = counter + 1

Next key

End Sub
QHarr
  • 83,427
  • 12
  • 54
  • 101
  • code returns error9-subscript out of range. for example when: msgbox arr2(x,y). moreover it seems that we may replace arr with arr1 in populating second column. – user7181718 Jan 23 '18 at 08:49
  • I made a typo at the start. Can you check now? If not, can you make a [pastebin](https://pastebin.com/) so i can see where the error in your version is as works here. I had just missed the 1 off arr1 when typing the assignments. – QHarr Jan 23 '18 at 09:01
  • the transpose shifts the start to 1 rather than 0. If you put STOP before the Msgbox, run the code and then look at arr2 in the locals window you will see the change. The start value becomes arr2(1,1). Apologies, I should have mentioned this. – QHarr Jan 23 '18 at 11:05
  • You could simply put ReDim arr2(1 to 2, 1 to FruitDict.Count ) but you would still need to access from (1,1) – QHarr Jan 23 '18 at 11:08
  • thank you QHarr! it works. i think first redim line is omissible. – user7181718 Jan 23 '18 at 11:40
  • is it possible to programmatically transpose an array? – user7181718 Jan 23 '18 at 11:43
  • See here: https://stackoverflow.com/questions/20055784/best-workaround-for-vba-transpose-array-length-limit – QHarr Jan 23 '18 at 11:49