Adding extra row to array

[tiredofit]

I have some data on my worksheet a follows:

a  1
a  2 
b  3
b  4

I want something to sum the values according to the value in column a, ie I want a to return 3 and b to return 7.

    Dim MyArray() As Variant
    
    MyArray = Cells(1, 1).CurrentRegion.Value
    
    Dim Counter As Integer
    
    For Counter = 1 To UBound(MyArray, 1)
    
        If MyArray(Counter, 1) = MyArray(Counter + 1, 1) Then
            
            
        
        End If
        
    Next Counter

The code above errors because it exceeds the dimension declared by Ubound.

So must I create a new array with one extra row, then read all the elements from MyArray into this new array before proceeding with the above code?

Like this:

Dim MyArray() As Variant
    
    MyArray = Cells(1, 1).CurrentRegion.Value
    
    
    Dim NewArray() As Variant
    
    ReDim NewArray(1 To UBound(MyArray, 1) + 1, 1) As Variant
    
    
    Dim i As Integer
    
    For i = 1 To UBound(MyArray, 1)
    
        NewArray(i, 1) = MyArray(i, 1)
        
    Next i
    
    Dim Counter As Integer
    
    For Counter = 1 To UBound(NewArray, 1) - 1
    
        If NewArray(Counter, 1) = NewArray(Counter + 1, 1) Then
            
            
        
        End If
        
    Next Counter

Thanks

 

[MickG]

This is a possible option, Results start "F1".

[COLOR="Navy"]Sub[/COLOR] MG14Feb56
[COLOR="Navy"]Dim[/COLOR] MyArray()   [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ray()        [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] temp        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Counter     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
MyArray = Cells(1, 1).CurrentRegion.Value
    
[COLOR="Navy"]For[/COLOR] Counter = 1 To UBound(MyArray, 1)
    [COLOR="Navy"]If[/COLOR] Not temp = MyArray(Counter, 1) [COLOR="Navy"]Then[/COLOR]
        temp = MyArray(Counter, 1)
        c = c + 1
        ReDim Preserve Ray(1 To 2, 1 To c)
        Ray(1, c) = temp: Ray(2, c) = MyArray(Counter, 2)
     [COLOR="Navy"]Else[/COLOR]
         Ray(2, c) = Ray(2, c) + MyArray(Counter, 2)
    [COLOR="Navy"]End[/COLOR] If
        
[COLOR="Navy"]Next[/COLOR] Counter
    Range("F1").Resize(c, 2) = Application.Transpose(Ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[tiredofit]

Thanks, works well.

 

[MickG]

You're welcome

 

[Rick Rothstein]

If you have less than 65536 rows of data, here is an alternate macro that you can consider...

[table="width: 500"]
[tr]
	[td]Sub GetGroupTotals()
  Dim X As Long, Data As Variant
  Data = Range("A1", Cells(Rows.Count, "B").End(xlUp))
  With CreateObject("Scripting.Dictionary")
    For X = 1 To UBound(Data)
      .Item(Data(X, 1)) = .Item(Data(X, 1)) + Data(X, 2)
    Next
    Range("F1").Resize(.Count) = Application.Transpose(.Keys)
    Range("G1").Resize(.Count) = Application.Transpose(.Items)
  End With
End Sub[/td]
[/tr]
[/table]

 

[tiredofit]

If you have less than 65536 rows of data, here is an alternate macro that you can consider...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub GetGroupTotals()
  Dim X As Long, Data As Variant
  Data = Range("A1", Cells(Rows.Count, "B").End(xlUp))
  With CreateObject("Scripting.Dictionary")
    For X = 1 To UBound(Data)
      .Item(Data(X, 1)) = .Item(Data(X, 1)) + Data(X, 2)
    Next
    Range("F1").Resize(.Count) = Application.Transpose(.Keys)
    Range("G1").Resize(.Count) = Application.Transpose(.Items)
  End With
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]

Thanks but I have A LOT more than 65536 rows of data!

I suspect your method doesn't work for more than 65536 because of the transposition, so I suppose I could adapt your transposition part.