0

I have an excel sheet (examplary extract below) and would like to achieve following with my VBA code (I am a total newbie to VBA).

  • Go through all rows in coloumn A
  • Calculate Average value for range in column E with identical dates (column A)
  • generate a new table with rows: dates; col: average values and create table in a new worksheet.

Important Note:

  • Ranges can have different number of rows depending on the number of values (E) for a date (A)

As a starting point I have following VBA Code:

1 Sub GotoNewState()

3 Dim i As Integer
4 Dim startRange As Integer
5 i = 0

7 Do
8     i = i + 1
9     If Cells(ActiveCell.Row + i, ActiveCell.Column).Value <> ActiveCell.Value Then
10         Cells(ActiveCell.Row + i, ActiveCell.Column).Select
11        startRange = -(i - 1)
12         'MsgBox startRange
13        ActiveCell.Offset(-1, 5).FormulaR1C1 = "=AVERAGE("R[" & startRange & "]C[-1]":RC[-1])"
14         Exit Do
15    End If
16 Loop

18 End Sub

However I have problems with the syntax for R1C1 notation as the argument I want to pass to R[argument] returns an error.

I would be happy about other solutions to my described intention above.

Extract from Excel:

A          B C   D    E
13.03.2015 1 300 5.00 0
13.03.2015 2 300 5.00 40
13.03.2015 3 300 5.00 4
13.03.2015 4 300 5.00 2
13.03.2015 5 300 5.00 2
13.03.2015 6 300 5.00 22
20.03.2015 6 300 5.00 0
20.03.2015 5 300 5.00 14
20.03.2015 1 300 5.00 1
20.03.2015 2 300 5.00 0
20.03.2015 3 300 5.00 0
20.03.2015 4 300 5.00 0
27.03.2015 3 300 5.00 0
27.03.2015 4 300 5.00 3
27.03.2015 2 300 5.00 15
27.03.2015 6 300 5.00 147
27.03.2015 5 300 5.00 14
27.03.2015 1 300 5.00 0
02.04.2015 1 300 5.00 8
02.04.2015 2 300 5.00 0
02.04.2015 3 300 5.00 63
02.04.2015 4 300 5.00 0
02.04.2015 5 300 5.00 0
02.04.2015 6 300 5.00 3
17.04.2015 1 300 5.00 7
17.04.2015 2 300 5.00 1
17.04.2015 3 300 5.00 19
17.04.2015 4 300 5.00 0
17.04.2015 5 300 5.00 159
17.04.2015 6 300 5.00 84
30.04.2015 1 300 5.00 0
30.04.2015 2 300 5.00 0
30.04.2015 3 300 5.00 2
30.04.2015 3 300 5.00 2
30.04.2015 4 300 5.00 0
30.04.2015 5 300 5.00 182
30.04.2015 6 300 5.00 2
...
Aliakbar Ahmadi
  • 366
  • 3
  • 14
  • 3
    you can use Pivot table also to achieve this – Maddy Mar 07 '18 at 09:36
  • Thanks! That worked fine - still it would be interesting to know a VBA dynamic code :) – Aliakbar Ahmadi Mar 07 '18 at 09:42
  • 1
    Could you not use `AVERAGEIF` to do this? – Tom Mar 07 '18 at 09:48
  • 1
    As a solution to what you are looking for, I would go with @Maddy and @Tom suggestions. On the other hand if you want to do this just so that you can get some practice on VBA.. it's a good start. Here are some pointer: I would use a `FOR` loop instead of a `DO` loop. Search on how you can get the last row in a sheet (there are plenty of examples). Also, your `IF` statement inside the loop can use `Offset`. Good luck – Zac Mar 07 '18 at 10:00

2 Answers2

0

If you still want to do this in VBA, then

1.Copy column A unique values in new column

2.then use AVERAGEIF formula to calculate

For example: Below code copies unique dates from column A and paste it in column G and calculate avg using AVERAGEIF formula in column H

    Sub getAvg()
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Range("A60000").End(xlUp).Row ' Last Row number in Column A
    'ws.Range("G1").Value = "Dates"
    ws.Range("H1").Value = "Avg"
    ws.Range("A1:A" & lastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("G1"), Unique:=True ' copy unique values using AdvancedFilter 
    lastRowNewTble = ws.Range("G60000").End(xlUp).Row ' Last Row number in Column G
    ws.Range("H2:H" & lastRowNewTble).Formula = "=AVERAGEIF(A2:A" & lastRow & ",G2,E2:E" & lastRow & ")" ' write formula in column G
    End Sub
Maddy
  • 771
  • 5
  • 14
0

If you don't want to use filters, you can try with loops. This code will calculate averages for the ranges and put them in F column:

Dim unqDateDict As Scripting.Dictionary
Dim lastRow As Integer
Dim i As Integer
Dim count As Integer
Dim currDate As String

Set unqDateDict = New Scripting.Dictionary

lastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
count = -1

'Fill dictionary with unique dates
For i = 1 To lastRow
    currDate = Range("A" & i).Value
    If Not unqDateDict.Exists(currDate) Then
        unqDateDict.Add currDate, count
        count = count + 1
    End If
Next

'Calculate averages
Dim tempSum As Integer
Dim keyIndex As Integer
Dim loopIndex As Integer
Dim loopCounter As Integer
Dim Key
loopIndex = 1
keyIndex = 1
loopCounter = 0
For Each Key In unqDateDict.Keys
    For i = loopIndex To lastRow
        If CStr(Range("A" & loopIndex).Value) = Key Then
            tempSum = tempSum + Range("E" & loopIndex).Value
            loopIndex = loopIndex + 1
            loopCounter = loopCounter + 1
        Else
            Range("F" & keyIndex) = tempSum / loopCounter
            loopCounter = 0
            tempSum = 0
            keyIndex = keyIndex + 1
            Exit For
        End If
    Next

Next Key

End Sub

user9435009
  • 1