Average values within time range for matching header

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.

Attachment 18142Attachment 18143

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)))

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

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:

Code:

---

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

---

VBA Code

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.

Quote:

---

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"

Code:

---

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 taCell

---

That 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.

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.

Code:

---

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

New code pasted below for quick review

Code:

---

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

---

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.

Code:

---

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

---

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:

Code:

---

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

---