hope someone could help -Macro to assist averaging data set's over multiple worksheets

Fringedweller

New Member
Joined
Jan 21, 2018
Messages
6
I am hoping that someone can help me with a macro to average data from multiple time points
Simply i have a 4 columns Day, Date, Time, Data
The same format appears on each worksheet with in the workbook which i need sort and Average over the data range

The data sort should be by date (ascending) then by Time (Ascending)
Time is based on a 24 Hour period data points can arrive at any point during this period

I would like to add that i have tried to do it my self using the inbuilt sort functions but can no seem to get it to work across multiple sheets
also i got lost in the Pivot table grouping options

Cell range on all worksheets is Range("A2:D500") Includes headers A2-D2
I guess the output columns would be F2:G500 F=Time(whole Hour, example 1am, 2am, 3am ..etc) g= averaged data from previous time until current time

Then i can Graph the averages of a week based on date and hourly intervals for each worksheeet
my goal is then combine all worksheets into a single graph using each worksheets title as labels

example of data
DayDate TimeData
Sat2023:37:291.2
Sat2023:27:461.2
Sat2020:45:091.2
Sat2020:41:541.7
Sat2020:38:392.3
Sat2020:35:241.9
Sat2018:21:511.4
Sat2012:32:571.2
Sat2012:29:421.4
Fri1921:14:291.2
Fri1917:20:281.2
Fri1917:17:141.3
Fri1917:13:571.2
Fri195:39:401.3
Thu184:09:201.2
Wed1715:50:401.3
Wed1713:21:031.3
Wed170:19:001.4
Wed170:15:491.5
Wed170:12:381.3
Mon1520:32:291.4
Mon156:41:321.2
Mon156:38:191.3
Sun1414:12:301.2
Sun1414:09:151.4

<colgroup><col style="text-align: center;"><col style="text-align: center;"><col style="text-align: center;"><col style="text-align: center;"></colgroup><tbody>
</tbody>
I hope i have given enough information for someone to assist..

Cheers... any other questions please ask
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
My Current Macro

Sub Datapoints()


' Import Files from C:\Raw Data
Dim strFile As String
Dim WS As Worksheet
strFile = Dir("C:\Raw Data\*.csv")
Do While strFile <> vbNullString
Set WS = Sheets.Add
With WS.QueryTables.Add(Connection:= _
"TEXT;" & "C:\Raw Data" & strFile, Destination:=Range("$A$1"))
.Name = strFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop


' Delete not needed cells on all worksheets
Dim a As Long
For a = 1 To Sheets.Count
Worksheets(a).Range("B:B").ClearContents
Worksheets(a).Range("D:N").ClearContents
Next a
MsgBox "Complete"
On Error Resume Next
For Each WS In ThisWorkbook.Worksheets
WS.Name = Left(WS.Cells(1, 1).Value, 31)
Next
On Error GoTo 0
For Each WS In ThisWorkbook.Worksheets


' Increase all data values by 1 to ensure all values are >1
WS.Activate
Range("D3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>0.1,RC[-1]+1,"""")"
Selection.AutoFill Destination:=Range("D3:D1000"), Type:=xlFillDefault
Range("D3:D1000").Select
WS.Activate


' Copy & Paste Data field as text intead of formula
Columns("D:D").Select
Selection.Copy
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:E").Select
Selection.ClearContents

' extract contents - Day, Date and Time from Rows
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A:A"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
Range("E2").Select
ActiveCell.FormulaR1C1 = "Time"
Range("F2").Select
ActiveCell.FormulaR1C1 = "Data"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Day"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Date"
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("A:D").Select
Columns("A:D").EntireColumn.AutoFit

' Format Columns
Columns("A:A").Select
Selection.NumberFormat = "@"
Columns("B:B").Select
Selection.NumberFormat = "[$-409]h:mm AM/PM;@"
Columns("B:B").Select
Selection.NumberFormat = "[$-409]d-mmm;@"
Columns("C:C").Select
Selection.NumberFormat = "[$-409]h:mm AM/PM;@"
Columns("D:D").Select
Selection.NumberFormat = "0.00"

' Bold Fields Headers
Range("A2:D2").Select
Selection.Font.Bold = True
Range("A1").Select
Selection.Font.Bold = True
Sheets("Main Sheet").Select
Range("A1:T1").Select
Selection.ClearContents
Next
End Sub




'" Ok this is where I have a lot of trouble,
'" I need an Hourly Average for the data contained in "Data"(column D) on each worksheet over the Data Range (Date and time)
'" Example data between - 1am : 2am will be displayed as an average at 2am
'" Maybe using column "F" showing hourly intervals starting F3 and using column "G" to show associated averaged data for that time period


'" The Averages will then be graphed in chronological order on each worksheet over the range period (Number of Days)
'" Finally this average data from all worksheets will be consolidated to create Main Graph on Worksheet "Main Sheet"
'" I now hope that you can see what I am trying to achieve
 
Upvote 0

Forum statistics

Threads
1,213,539
Messages
6,114,221
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top