PolygonS1
PolygonS1

Reputation: 23

Excel VBA: Find range of cells for each day (non specified) and apply formula in a new cell

this is my first time posting but a quick thank you to the community for all the help this site has already gave me at University & Work.

Problem Summary: I have network data, recorded every 15 minutes by day in a datetime format, with the bit rate in and out in separate columns. The goal is to apply several formulas to each day (such as In Average, Out 90th Percentile etc.) However, these formulas need to be applied to every single day, without a specific day being inputted by the user or included in the code.

This is where I am really struggling, I've spent a couple of days now trying to crack it but every similar example I can find requires a user specified date.

The reason I need VBA for this task, is because I have over 50 reports each with a month's data, eventually the code will import each report, apply the formulas then export them as CSVs for use in another workbook.

Current Spreadsheet Example

Time             | In Bit Rate | Out Bit Rate
01/02/2017 15:00 | 11200       | 42300
01/02/2017 15:15 | 14100       | 47400
01/02/2017 15:30 | 11300       | 42300
02/02/2017 15:00 | 12100       | 44100
02/02/2017 15:15 | 11500       | 42600
02/02/2017 15:30 | 12400       | 44700

Desired Outcome Example

Time             | In Bit Rate | Out Bit Rate | In Bit Rate Average | Out Bit Rate Average
01/02/2017 15:00 | 11200       | 42300        | 12200               | 44000
01/02/2017 15:15 | 14100       | 47400        |                     |
01/02/2017 15:30 | 11300       | 42300        |                     |
02/02/2017 15:00 | 12100       | 44100        | 12000               | 43800
02/02/2017 15:15 | 11500       | 42600        |                     |
02/02/2017 15:30 | 12400       | 44700        |                     |

Essentially the main difficulty I'm having is making the date selection, and ensuring the code runs for each and every day, I assume a loop would be useful in this instance but I'm not sure how it would pick out each separate day to begin with.

The one idea I started to pursue was to extract the date from each date time value into a new column, then handle the new date cells as 'duplicates', then I would have my row selection. However, this didn't feel like perhaps the most effective way of completing the task.

Upvotes: 2

Views: 463

Answers (2)

A.S.H
A.S.H

Reputation: 29332

A formula solution. Assuming your columns are A, B, C, D and E, type the following formula in D2 then copy/paste it along all the cells in of D and E.

=IF(DAY($A2)<>IFERROR(DAY($A1), 0),AVERAGEIFS(B:B,$A:$A,">="&INT($A2),$A:$A,"<"&1+INT($A2)), "")

enter image description here

Upvotes: 0

CMArg
CMArg

Reputation: 1567

Try this. Data is supposed to be in sheet "MyData". The present code just perform operations with column 2 ("In Bit Rate"). You'll have to adjust it to fit your needs. Basically, data is temporary stored in an array. This code would work only if column A is ordered. Anyway, I think the main interest to you lies in the Day function.

Private Sub CommandButton1_Click()
Dim MyArray() As Variant
Dim lLastRow As Long
Dim i As Long

    lLastRow = Worksheets("MyData").UsedRange.Rows.Count
    ReDim MyArray(1 To 1) As Variant

    For i = 1 To lLastRow
        If (Day(Worksheets("MyData").Cells(i + 1, 1)) <> Day(Worksheets("MyData").Cells(i, 1))) Then
            MyArray(UBound(MyArray)) = Worksheets("MyData").Cells(i, 2).Value
            Worksheets("MyData").Cells(i, 4) = Application.WorksheetFunction.Average(MyArray)
            Worksheets("MyData").Cells(i, 5) = Application.WorksheetFunction.StDev(MyArray)
            Worksheets("MyData").Cells(i, 6) = Application.WorksheetFunction.Percentile(MyArray, 0.9)
            ReDim MyArray(1 To 1) As Variant 'reset array for next day
        Else
            MyArray(UBound(MyArray)) = Worksheets("MyData").Cells(i, 2).Value 'add data to array
            ReDim Preserve MyArray(1 To UBound(MyArray) + 1) As Variant 'now array is 1 element longer

        End If
    Next i
End Sub

Upvotes: 1

Related Questions