Average values within time range for matching header

[vijyat]

Hi,

I am trying to write a VBA script so I can take the average of sample data that falls within the specific time range for the respective date for a matching column. The data is captured every 20sec when the system is on and creates an excel file "Data". I need to perform reporting and analytics for that data hence I created a new excel file named "Table" with 15 min time increments.

I used one of my old codes along with some help online however, I am not getting anywhere. Hence would appreciate any help.

What I am trying to achieve here : For every data sample that belongs to that 15 min interval whether its 1 entry or 300 entries (20sec *15), the cell in the main "table" file would be the average of the data set within the data file for the respective date and respective column header. similarly it should then move on to the next column header and do the same average for the data set for that 15 min interval and after it has copied data for all the column headers then it moves to the next set of time interval.

Attaching two sample files Data & Table. I have filled the Table file manually for now but I would like a VBA script for that.

Sample filled "Table" File : for time range B3 & C3 and column header "A" the average value entered is 1.222 and so on...

The value 1.222 is the average value from "Data" file C3:C8 for column header "A" as the datestamp in column B falls between the time range in Table file for Row 3.

1814218143

[SamT]

Sounds like a case for WorksheetFunction.VLookUp

If VLookUp does not find an exact match for the value, it returns the next lower value. This will give you an exact value to Find. Find can return the Row number of the found Value. (VLookUp for 12:14:59 AM will return 12:13:40 AM)

In the case of the starting Time Row, you will have to check to see if the value is the exact value in the time column and if not, add 1 to the starting row. In the case of the end time row, this is not necessary.

Once you have the row numbers then for each column, The Average is Average(Range(Cells(StartRow, Column), Cells(EndRow,Column)))

[vijyat]

Hey Sam,

Thanks for helping out. So i tried using vlookup (formulas and NOT vba) . I am adding the formula in the "table" sheet and pulling up values(range) from "data" sheet. The vlookup function as you mentioned returns the next lower value. However, for the time range against which there are no values in the data sheet, it's still giving me the next lower value which defeats the purpose. Also then, if there are multiple values in the data table which fall within one 15min time range category how do I select those only to be averaged later. ?

thnx

[SamT]

Sorry, I wasn't clear.

I think you can use WorksheetFunction.VLookUp in a VBA Procedure to accomplish what you need.

VBA can use Excel functions by specifying WorksheetFunction as the "owner" of the function.

Excel Sheet Formula:

=VLookUp(A1:B10,"XZY",2)

VBA Code

Var = WorksheetFunction.VLookUp(Sheet1.Range("A1:B10"), "XZY", 2)

I think. I don't have my help files on this computer, and I don't do much with Excel Formulas, so my syntax may be off.

[SamT]

However, for the time range against which there are no values in the data sheet, it's still giving me the next lower value which defeats the purpose. Also then, if there are multiple values in the data table which fall within one 15min time range category how do I select those only to be averaged later. ?

One such pure VBA method follows.
For this code all variables that refere toSheet "Table" are prefixed with "ta", and those referring to sheet "Data" with "da"


Dim taTimesRng As Range
Dim taStart as Date
Dim taEnd as Date
Dim taCell As Range

Dim daTimesRng as Range
dim daStartCell As Range
Dim daEndCell AS Range
Dim daStartRow as long
Dim daEndRow as long

Set daEndCell = Sheets("Data").Range("B3") 'initial location

Set taTimesRng = Sheets("Table").Range(Range("B3"), Range("B3").End(xlDown)
For each taCell in taTimesRng
taStartTime =taCell
taEndEndTime = taCell.Offset(, 1)

Set daStartcell = daEndCell 'important the next time thru the For...Next loop

Do while daStartcell < taStartTime
Set daStartcell = daStartcell.Offset(1)
Loop

Set daEndCell = daStartcell

Do While daEndCell.Offset(1) <= taEndEndTime
Set daEndCell = daEndCell.Offset(1)
Loop

daStartRow =daStartCell.Row 'Top row of time bracket
daEndRow = daEndCell.Row 'bottom row of time bracket

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '
'compute averages here
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '

Next taCellThat code is off the top of my head and is not tested in any way.

If it were me, I would replace "'compute averages here" with a call to another sub and pass taCell, daEndRow and daStartRow to that sub for processing.

Two subs, each with separate jobs, makes troubleshooting easier.

[vijyat]

Sam,

You gave me a great head start. I took your code and modified it to loop it through the column headers by matching them within the two files , averaging them and then pasting them. There still seems to be some error within the time range loop . Example : Row 12 in Data file has a timestamp of " 02:38:10 " lies between the timestamp of " 02:30:00 & 02:44:59 ", however the average for that row/range is being copied under the timestamp " 00:30:00 & 00:44:59 " Row 5. it shouldn't be the case. The first 2 rows of the Table file are filled accurately as per the code while taking values from Data file.
I know that the below lines of code need to be modified however i can't seem to figure out :banghead: :crying:. Hence I need your help one more time respected Sir. Please and Thank You.

For Each taCell In taTimesRng taStartTime = taCell
taEndTime = taCell.Offset(, 1)
taCellRow = taCell.Row

Set daStartCell = daEndCell

Do While daStartCell < taStartTime
Set daStartCell = daStartCell.Offset(1)
Loop

Set daEndCell = daStartCell

Do While daEndCell.Offset(1) <= taEndTime
'Do While daEndCell.Offset(1) <= taEndTime
Set daEndCell = daEndCell.Offset(1)
Loop

I am reattaching the two sheets with updated code in the "Table" File Module 1. :help

[vijyat]

New code pasted below for quick review

Sub Merge_Average()

'General variables
Dim StartTime As Double
Dim myPath As String
Dim myExtension As String
Dim FilePicker As FileDialog
Dim MinutesElapsed As String
Dim Average As Double
Dim Value As Double


'Table file variables defined below
Dim wb1 As Workbook ' Table Workbook
Dim taTimesRng As Range
Dim taStartTime As Date
Dim taEndTime As Date
Dim taCell As Range
Dim currentColumnTa As Integer ' current column number in "Table" File
Dim columnHeadingTa As String ' current column name in "Table" File
Dim taCellRow As Long



'Data file variables defined below
Dim wb2 As Workbook ' Data Workbook
Dim daTimesRng As Range
Dim daStartCell As Range
Dim daEndCell As Range
Dim daStartRow As Long
Dim daEndRow As Long
Dim currentColumnDa As Integer ' current column number in "Data" File
Dim columnHeadingDa As String ' current column name in " Data" File





StartTime = Timer ' Countdown clock




Set wb1 = ThisWorkbook




Application.ScreenUpdating = False ' Switching this to False optimizes Macro Speed.
Application.EnableEvents = False ' This blocks any popups
Application.Calculation = xlCalculationManual ' This optimizes the processor output




Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
With FilePicker

.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) '& "\"
End With





NextCode:

If myPath = "" Then GoTo ResetSettings






Set wb2 = Workbooks.Open(Filename:=myPath)




Set daEndCell = wb2.Sheets("Data").Range("B3")
wb1.Activate
Set taTimesRng = wb1.Sheets("Table").Range(Range("B3"), Range("B3").End(xlDown))




For Each taCell In taTimesRng
taStartTime = taCell
taEndTime = taCell.Offset(, 1)
taCellRow = taCell.Row

Set daStartCell = daEndCell

Do While daStartCell < taStartTime
Set daStartCell = daStartCell.Offset(1)
Loop

Set daEndCell = daStartCell

Do While daEndCell.Offset(1) <= taEndTime
'Do While daEndCell.Offset(1) <= taEndTime
Set daEndCell = daEndCell.Offset(1)
Loop

daStartRow = daStartCell.Row 'Top row of time bracket
daEndRow = daEndCell.Row 'Bottom row of time bracket

currentColumnTa = 4
columnHeadingTa = wb1.Sheets("Table").Cells(1, currentColumnTa).Value
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '
'Loop and match column headers in Data and Table, compute and copy average values then paste in Table sheet and then loop through rows with start and end time
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '
Do While columnHeadingTa <> ""

currentColumnDa = 3
columnHeadingDa = wb2.Sheets("Data").Cells(1, currentColumnDa).Value




Do While columnHeadingDa <> ""
wb2.Activate
With wb2.Sheets("Data").Select


If columnHeadingDa = columnHeadingTa Then


Average = Format(Application.WorksheetFunction.Average(Range(Cells(daStartRow, currentColumnDa), Cells(daEndRow, currentColumnDa))), "0.000")


DoEvents


wb1.Activate

With wb1.Sheets("Table").Select



ActiveSheet.Cells(taCellRow, currentColumnTa).Value = Average



End With

' End If

GoTo MasterFile

End If

End With
currentColumnDa = currentColumnDa + 1
columnHeadingDa = wb2.Sheets("Data").Cells(1, currentColumnDa).Value

Loop
MasterFile:
currentColumnTa = currentColumnTa + 1
columnHeadingTa = wb1.Sheets("Table").Cells(1, currentColumnTa).Value


Loop




Next taCell




MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss") ' Determine how many seconds the code took to run




ResetSettings:
' Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


' Message Box when tasks are completed

MsgBox "Task Complete!. This code ran successfully in" & MinutesElapsed & " minutes", vbInformation




End Sub

[SamT]

Indicated below is the only place I see what might be an error in logic. nb: This is a slightly edited version of your code. I removed some redundancies.

Option Explicit

Sub Merge_Average()

'General variables
Dim StartTime As Double
Dim myPath As String
Dim myExtension As String
Dim FilePicker As FileDialog
Dim MinutesElapsed As String
Dim Average As Double
Dim Value As Double

'Table file variables defined below
Dim wb1 As Workbook ' Table Workbook
Dim taTimesRng As Range
Dim taStartTime As Date
Dim taEndTime As Date
Dim taCell As Range
Dim currentColumnTa As Integer ' current column number in "Table" File
Dim columnHeadingTa As String ' current column name in "Table" File
Dim taCellRow As Long

'Data file variables defined below
Dim wb2 As Workbook ' Data Workbook
Dim daTimesRng As Range
Dim daStartCell As Range
Dim daEndCell As Range
Dim daStartRow As Long
Dim daEndRow As Long
Dim currentColumnDa As Integer ' current column number in "Data" File
Dim columnHeadingDa As String ' current column name in " Data" File

StartTime = Timer ' Countdown clock
Set wb1 = ThisWorkbook

Application.ScreenUpdating = False ' Switching this to False optimizes Macro Speed.
Application.EnableEvents = False ' This blocks any popups
Application.Calculation = xlCalculationManual ' This optimizes the processor output

Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
With FilePicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) '& "\"
End With

NextCode:
If myPath = "" Then GoTo ResetSettings

Set wb2 = Workbooks.Open(Filename:=myPath)
Set daEndCell = wb2.Sheets("Data").Range("B3")
wb1.Activate
Set taTimesRng = wb1.Sheets("Table").Range(Range("B3"), Range("B3").End(xlDown))

For Each taCell In taTimesRng
taStartTime = taCell
taEndTime = taCell.Offset(, 1)
taCellRow = taCell.Row
Set daStartCell = daEndCell

Do While daStartCell < taStartTime
Set daStartCell = daStartCell.Offset(1)
Loop

Set daEndCell = daStartCell

Do While daEndCell.Offset(1) <= taEndTime
Set daEndCell = daEndCell.Offset(1)
Loop

daStartRow = daStartCell.Row 'Top row of time bracket
daEndRow = daEndCell.Row 'Bottom row of time bracket
currentColumnTa = 4
columnHeadingTa = wb1.Sheets("Table").Cells(1, currentColumnTa).Value

'Loop and match column headers in Data and Table, compute and copy average values then paste in Table sheet and then loop through rows with start and end time
Do While columnHeadingTa <> ""
currentColumnDa = 3
columnHeadingDa = wb2.Sheets("Data").Cells(1, currentColumnDa).Value

Do While columnHeadingDa <> ""
With wb2.Sheets("Data")
If columnHeadingDa = columnHeadingTa Then
Average = Format(Application.WorksheetFunction.Average(Range(Cells(daStartRow, currentColumnDa), Cells(daEndRow, currentColumnDa))), "0.000")
DoEvents

With wb1.Sheets("Table")
ActiveSheet.Cells(taCellRow, currentColumnTa).Value = Average
End With

GoTo MasterFile '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
End If
End With 'wb2.Sheets("Data")

currentColumnDa = currentColumnDa + 1
columnHeadingDa = wb2.Sheets("Data").Cells(1, currentColumnDa).Value
Loop 'columnHeadingDa

MasterFile:
currentColumnTa = currentColumnTa + 1
columnHeadingTa = wb1.Sheets("Table").Cells(1, currentColumnTa).Value
Loop 'columnHeadingTa

Next taCell

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss") ' Determine how many seconds the code took to run
ResetSettings:

' Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

' Message Box when tasks are completed
MsgBox "Task Complete!. This code ran successfully in" & MinutesElapsed & " minutes", vbInformation
End Sub

[vijyat]

Hey Sam,

This below code is what I was able to modify (By adding an "if" statement comparison) and it seem to work. my earlier code had a lot of redundancies. I don't know how to optimize it though. But the below code works flawlessly now. Marking the thread as solved :friends:

Sub Merge_Average()

'General variables
Dim StartTime As Double
Dim myPath As String
Dim myExtension As String
Dim FilePicker As FileDialog
Dim MinutesElapsed As String
Dim Average As Double
Dim Value As Double


'Table file variables defined below
Dim wb1 As Workbook ' Table Workbook
Dim taTimesRng As Range
Dim taStartTime As Double
Dim taEndTime As Double
Dim taCell As Range
Dim currentColumnTa As Integer ' current column number in "Table" File
Dim columnHeadingTa As String ' current column name in "Table" File
Dim taCellRow As Long

'Data file variables defined below
Dim wb2 As Workbook ' Data Workbook
Dim daStartCell As Range
Dim daEndCell As Range
Dim daStartRow As Long
Dim daEndRow As Long
Dim currentColumnDa As Integer ' current column number in "Data" File
Dim columnHeadingDa As String ' current column name in " Data" File

StartTime = Timer ' Countdown clock


Set wb1 = ThisWorkbook


Application.ScreenUpdating = False ' Switching this to False optimizes Macro Speed.
Application.EnableEvents = False ' This blocks any popups
Application.Calculation = xlCalculationManual ' This optimizes the processor output


Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
With FilePicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) '& "\"
End With

NextCode:
If myPath = "" Then GoTo ResetSettings


Set wb2 = Workbooks.Open(Filename:=myPath)
Set daEndCell = wb2.Sheets("Data").Range("B3")


wb1.Activate
Set taTimesRng = wb1.Sheets("Table").Range(Range("B3"), Range("B3").End(xlDown))
For Each taCell In taTimesRng
taStartTime = taCell
taEndTime = taCell.Offset(, 1)
taCellRow = taCell.Row
Set daStartCell = daEndCell


Do While daStartCell < taStartTime
Set daStartCell = daStartCell.Offset(1)
Loop
Set daEndCell = daStartCell

If daEndCell.Offset(1) = "" Then GoTo ResetSettings
Do While daEndCell.Offset(1) <= taEndTime

Set daEndCell = daEndCell.Offset(1)
Loop

daStartRow = daStartCell.Row 'Top row of time bracket
daEndRow = daEndCell.Row 'Bottom row of time bracket
If daEndCell <= taEndTime Then ' This additional if statement modification after the start and endrow loop made all the difference

currentColumnTa = 4
columnHeadingTa = wb1.Sheets("Table").Cells(1, currentColumnTa).Value
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '
'Loop and match column headers in Data and Table, compute and copy average values then paste in Table sheet and then loop through rows with start and end time
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '
Do While columnHeadingTa <> ""
currentColumnDa = 3
columnHeadingDa = wb2.Sheets("Data").Cells(1, currentColumnDa).Value

Do While columnHeadingDa <> ""
wb2.Activate
With wb2.Sheets("Data").Select

If columnHeadingDa = columnHeadingTa Then
Average = Format(Application.WorksheetFunction.Average(Range(Cells(daStartRow, currentColumnDa), Cells(daEndRow, currentColumnDa))), "0.000")

DoEvents
wb1.Activate
With wb1.Sheets("Table").Select
ActiveSheet.Cells(taCellRow, currentColumnTa).Value = Average

End With

GoTo MasterFile

End If

End With
currentColumnDa = currentColumnDa + 1
columnHeadingDa = wb2.Sheets("Data").Cells(1, currentColumnDa).Value
Loop


MasterFile:
currentColumnTa = currentColumnTa + 1
columnHeadingTa = wb1.Sheets("Table").Cells(1, currentColumnTa).Value


Loop
End If
Next taCell
' Determine how many seconds the code took to run


ResetSettings: ' Reset Macro Optimization Settings

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "Task Complete!. This code ran successfully in" & MinutesElapsed & " minutes", vbInformation


End Sub