Contents
Format and Filter Data
back to top
Sub ColumnsStatsNansNegs()
'
' FixAllColumn Macro
' Fixes the width of all columns
'
''Modifications
'''Line 151 change 2nd half of bin list from 1, 1.1, 1.2 to 1, 1.3, 1.6 this makes max limit of histogram 4*Ave vs. 2*Ave
'
' Generate Average, Standard Deviation, Standard Error of Mean
' Max, Min, and Bins
Dim sheetCounter As Integer
'go through each worksheet and set the column widths
'then step through all of the data and clear all NaN
'and negative values
For Each ws In Worksheets
ws.Select
sheetCounter = ActiveSheet.Index
'set all column widths
Columns("A:A").ColumnWidth = 5.71
Columns("B:B").ColumnWidth = 5.86
Columns("C:C").ColumnWidth = 5.43
Columns("D:D").ColumnWidth = 7
Columns("F:F").ColumnWidth = 10
Columns("G:G").ColumnWidth = 14.86
Columns("H:H").ColumnWidth = 15
Columns("I:I").ColumnWidth = 16
Columns("J:J").ColumnWidth = 25.5
Columns("K:K").ColumnWidth = 13.29
Columns("L:L").ColumnWidth = 16
Columns("M:M").ColumnWidth = 21.2
Columns("N:N").ColumnWidth = 24.2
Columns("O:O").ColumnWidth = 9.6
'make column headers bold
Range("A1:O1").Select
Selection.Font.Bold = True
'clear all NaNs and negatives
Range("G3").Select
Selection.End(xlDown).Select
lastrow = ActiveCell.Row
'loop through all data entries
For irows = 3 To lastrow
For jcolumns = 7 To 14
If Cells(irows, jcolumns).Value = " NaN " Then
Cells(irows, jcolumns).Value = ""
ElseIf Cells(irows, jcolumns).Value < "0" Then
Cells(irows, jcolumns).Value = ""
End If
Next jcolumns
Next irows
'generate descriptive stats starting from first sheet
'must be performed on sheets with imported data only
'works on individual groups
'works on EPC and MEP all
If ws.ChartObjects.Count = 0 Then
'copy header to end of data
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Range("G3").Select
Selection.End(xlDown).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
Cells(myRow + 2, mycolumn).Select
ActiveSheet.Paste
Selection.Font.Bold = True
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Cells(myRow + 12, mycolumn).Select
ActiveSheet.Paste
Selection.Font.Bold = False
'make column header and populate descriptive stats cell
'select reference cell
Range("F3").Select
Selection.End(xlDown).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
Cells(myRow + 2, mycolumn).Select
'enter count, average, stdev, sem
Cells(myRow + 4, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Count"
Cells(myRow + 5, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Average"
Cells(myRow + 6, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Stdev"
Cells(myRow + 7, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events SEM"
'make column header bold
Range(Cells(myRow + 4, mycolumn), Cells(myRow + 7, mycolumn + 1)).Select
Selection.Font.Bold = True
'compute count,ave,stdev,sem
Cells(myRow + 4, mycolumn + 1).Select
ActiveCell.Value = "=COUNT(" & "G3:G" & myRow & ")"
Cells(myRow + 5, mycolumn + 1).Select
ActiveCell.Value = "=AVERAGE(G3:G" & myRow & ")"
Cells(myRow + 6, mycolumn + 1).Select
ActiveCell.Value = "=STDEV(G3:G" & myRow & ")"
Cells(myRow + 7, mycolumn + 1).Select
ActiveCell.FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
'populate all columns with count, ave, Std, SEM
Range(Cells(myRow + 4, mycolumn + 1), Cells(myRow + 7, mycolumn + 1)).Select
Selection.AutoFill Destination:=Range(Cells(myRow + 4, mycolumn + 1), Cells(myRow + 7, mycolumn + 8)), Type:=xlFillDefault
'Get refeernce cell for setting Min Max Bin
Range("F3").Select
Selection.End(xlDown).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
' enter min max bin
Cells(myRow + 9, mycolumn).Select
ActiveCell.Value = "min"
Selection.Font.Bold = True
Cells(myRow + 10, mycolumn).Select
ActiveCell.Value = "max"
Selection.Font.Bold = True
Cells(myRow + 12, mycolumn).Select
ActiveCell.Value = "Bin"
Selection.Font.Bold = True
'Clear columns old values
Cells(myRow + 13, mycolumn).Select
Range(Selection, Selection.End(xlDown)).ClearContents
'Fill column of Bin size, enter first 3 values then extend to 10 values
Cells(myRow + 13, mycolumn).Select
ActiveCell.FormulaR1C1 = "0"
Cells(myRow + 14, mycolumn).Select
ActiveCell.FormulaR1C1 = "0.1"
Cells(myRow + 15, mycolumn).Select
ActiveCell.FormulaR1C1 = "0.2"
'populate 1/2 bin size, extend first 3 values
Cells(myRow + 13, mycolumn).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFill Destination:=Range(Cells(myRow + 13, mycolumn), Cells(myRow + 13 + 10, mycolumn)), Type:=xlFillDefault
'populate 1/2 bin size, last 10 values
Cells(myRow + 13 + 11, mycolumn).Select
ActiveCell.FormulaR1C1 = "1.2"
Cells(myRow + 13 + 12, mycolumn).Select
ActiveCell.FormulaR1C1 = "1.4"
Cells(myRow + 13 + 13, mycolumn).Select
ActiveCell.FormulaR1C1 = "1.6"
'populate 2nd 1/2 bin size from the three values above
Cells(myRow + 13 + 11, mycolumn).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFill Destination:=Range(Cells(myRow + 13 + 11, mycolumn), Cells(myRow + 13 + 20, mycolumn)), Type:=xlFillDefault
' 'Populate bin list
' Cells(myRow + 13, mycolumn + 1).Select
' ActiveCell.Value = "=$G$" & myRow + 11 & "*F" & myRow + 13
' Cells(myRow + 13, mycolumn + 1).Select
' Selection.AutoFill Destination:=Range(Cells(myRow + 13, mycolumn + 1), Cells(myRow + 13 + 20, mycolumn + 1)), Type:=xlFillDefault
End If
Next ws
''Give more infor about Errors
'On Error GoTo ShowErrDescription
End Sub
''Show the extra error information
'ShowErrDescription:
'MsgBox Err.Description
Compute Data Stats, per event
back to top
Sub HistoPlot()
'
' JumpSheet Macro
' Make all histograms for all Data Sheets in Workbook
' Where each data sheet represents data for one group
'
Dim mySheetsNumber As Integer
Dim ws As Worksheet
Dim activeSheetsName As String
Dim mySheet As String
Dim myColumnLetter As String
Dim myID As String
Dim myName As String
Dim columnLetter(1 To 6) As String
columnLetter(1) = "G"
columnLetter(2) = "H"
columnLetter(3) = "I"
columnLetter(4) = "J"
columnLetter(5) = "M"
columnLetter(6) = "N"
Dim myTitle(1 To 6) As String
myTitle(1) = "Amplitude"
myTitle(2) = "Tau_Rise"
myTitle(3) = "Tau_Decay"
myTitle(4) = "Area Under Curve"
myTitle(5) = "Inter_Peak_Interval"
myTitle(6) = "Frequency"
Dim icountTitle As Integer
'index through all data sheets and generate
'histograms for the five parameters measured from muscle cells
'Amplitude, Tau-rise, Tau-decay, AreaUnderCurve, InterPeakInterval
'number of worksheets in workbook
'worksheets must be named accrodingly
mySheetsNumber = ActiveWorkbook.Worksheets.Count
For Each ws In Worksheets
ws.Select
activeSheetsName = ActiveSheet.Name
'MEP list of data sheets
If activeSheetsName = "Data_Summary_MEP_ALL" Then
mySheet = "MEP_ALL"
ElseIf activeSheetsName = "Data_Summary_EPC_ALL" Then
mySheet = "EPC_ALL"
ElseIf activeSheetsName = "Data_Summary_Analysis_MEP_W_P30" Then
mySheet = "MEP_W_P30"
ElseIf activeSheetsName = "Data_Summary_Analysis_MEP_W_P15" Then
mySheet = "MEP_W_P15"
ElseIf activeSheetsName = "Data_Summary_Analysis_MEP_T_P30" Then
mySheet = "MEP_T_P30"
ElseIf activeSheetsName = "Data_Summary_Analysis_MEP_T_P15" Then
mySheet = "MEP_T_P15"
'EPC list of data sheets
ElseIf activeSheetsName = "Data_Summary_Analysis_EPC_W_P30" Then
mySheet = "EPC_W_P30"
ElseIf activeSheetsName = "Data_Summary_Analysis_EPC_W_P15" Then
mySheet = "EPC_W_P15"
ElseIf activeSheetsName = "Data_Summary_Analysis_EPC_T_P30" Then
mySheet = "EPC_T_P30"
ElseIf activeSheetsName = "Data_Summary_Analysis_EPC_T_P15" Then
mySheet = "EPC_T_P15"
Else
mySheet = "Skip"
End If
'Make histograms if string is not "Skip"
If mySheet <> "Skip" Then
'Insert histogram plot macro here
For icountTitle = 1 To 6 'index through the 5 event parameters
'Create histogram sheet title
myColumnLetter = columnLetter(icountTitle)
myID = myTitle(icountTitle)
myName = myID & "_" & mySheet 'this is title of plot
'Select row range
Range("F3").Select
Selection.End(xlDown).Select
myRow = ActiveCell.Row
'Select Column
Range(myColumnLetter & "3").Select
mycolumn = ActiveCell.Column
'Compute min max and Bin size
'min
Cells(myRow + 9, mycolumn).Select
ActiveCell.Value = "=MIN(" & myColumnLetter & "3:" & myColumnLetter & myRow & ")" 'Min
'max
Cells(myRow + 10, mycolumn).Select
ActiveCell.Value = "=MAX(" & myColumnLetter & "3:" & myColumnLetter & myRow & ")" 'Max
'populate bin list
Cells(myRow + 13, mycolumn).Select
ActiveCell.Value = "=$" & myColumnLetter & "$" & myRow + 6 & "*F" & myRow + 13
Cells(myRow + 13, mycolumn).Select
Selection.AutoFill Destination:=Range(Cells(myRow + 13, mycolumn), Cells(myRow + 13 + 20, mycolumn))
'Run Histogram application on current parameter determined by column
' Application.Run "Histogram", ActiveSheet.Range(Cells(3, mycolumn), Cells(myRow, mycolumn)) _
' , myName, ActiveSheet.Range(Cells(myRow + 12, mycolumn), Cells(myRow + 12 + 21, mycolumn)), False, False _
' , True, True
' 'Return to Data Sheet
' ActiveSheet.Next.Select
Next icountTitle
End If
Next ws
''Give more infor about Errors
'On Error GoTo ShowErrDescription
End Sub
''Show the extra error information
'ShowErrDescription:
'MsgBox Err.Description
Compute Data Stats per cell
back to top
Sub statsperCell()
'
'
'Go through each data worksheet and
'generate the descriptive stats per cell
Dim ws As Worksheet
Dim myCellarray() As Integer
Dim icellmarker As Integer
Dim irowcount As Integer
Dim myRowscount As Integer
Dim thecurrentCell As Integer
Dim mylastrow As Integer
'Dim iformcount As Integer
'Dim myformgstring As String
Dim icountrow As Integer
Dim icountcol As Integer
Dim iavecount As Integer
Dim myAverage As Double
Dim avetempval As Double
'Inex through all worksheets
For Each ws In Worksheets
ws.Select
Range(Cells(3, 6), Cells(3, 6)).Select 'column indicating cell number
Selection.End(xlDown).Select
'total number of unique cells indicated by value of last entry in column F
mycellcount = ActiveCell.Value
myRowscount = ActiveCell.Row - 3
mylastrow = ActiveCell.Row
'loop through data extracting rowdata from individual cells use the array formed to find ranges of muscle cell data
ReDim myCellarray(0 To 0) As Integer 'initialize array
icellmarker = 0
For irowcount = 1 To myRowscount
thecurrentCell = Range(Cells(3 + irowcount, 6), Cells(3 + irowcount, 6)).Value
If thecurrentCell <> icellmarker Then
ReDim Preserve myCellarray(0 To icellmarker) As Integer
myCellarray(icellmarker) = irowcount + 3
icellmarker = icellmarker + 1
End If
Next irowcount
'Use myCellarray to make ranges of data and copy/paste into same worksheet, below descriptive stats
'need to make 28 entries
'MyCellarray has cell# of entries starting at 0, up to #cells-1
'Index of array ponints to start of cell, where cell# = index#+1, b/c index starts at 0
'Start of all cells
'Cell 1 = row3
'Cell 2 = myCellarray(1)
'Cell 3 = myCellarray(2)
'Cell 4 = myCellarray(3)
'...Cell icellmarker = myCellarray(icellmarker-1)
'End of all cells
'Cell 1 = myCellarray(1)-1
'Cell 2 = myCellarray(2)-1
'Cell 3 = myCellarray(3)-1
'Cell 4 = myCellarray(4)-1
'...Cell icellmarker = mylastrow
'Special condition for first and last cell range selection
'Loop through each cell data selection and copy below data descriptives
'35 rows after mylastrow. Three cases: 1-start, 2-end, 3-other
For icellcount = 1 To mycellcount
'Special condition for first row
If icellcount = 1 Then
'copy column header
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Cells(mylastrow + 34, 7).Select
ActiveSheet.Paste
'enter "Cell" header and cell number
Cells(mylastrow + 34, 5).Select
ActiveCell.Value = "Cell"
Cells(mylastrow + 35, 5).Select
ActiveCell.Value = icellcount
'get row and column numbers
Cells(mylastrow + 35, 6).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
'enter count, average, stdev, sem, min, max
Cells(myRow, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Count"
Cells(myRow + 1, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Average"
Cells(myRow + 2, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Stdev"
Cells(myRow + 3, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events SEM"
Cells(myRow + 4, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events MIN"
Cells(myRow + 5, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events MAX"
'compute the descriptive statistics
'compute count,ave,stdev,sem
Cells(mylastrow + 35, 7).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
Cells(myRow, mycolumn).Select
ActiveCell.Value = "=COUNT(" & "G3:G" & myCellarray(1) - 1 & ")"
Cells(myRow + 1, mycolumn).Select
ActiveCell.Value = "=AVERAGE(" & "G3:G" & myCellarray(1) - 1 & ")"
Cells(myRow + 2, mycolumn).Select
ActiveCell.Value = "=STDEV(" & "G3:G" & myCellarray(1) - 1 & ")"
Cells(myRow + 3, mycolumn).Select
ActiveCell.FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
Cells(myRow + 4, mycolumn).Select
ActiveCell.Value = "=MIN(" & "G3:G" & myCellarray(1) - 1 & ")"
Cells(myRow + 5, mycolumn).Select
ActiveCell.Value = "=MAX(" & "G3:G" & myCellarray(1) - 1 & ")"
'populate all columns with count, ave, Std, SEM
Range(Cells(myRow, mycolumn), Cells(myRow + 5, mycolumn)).Select
Selection.AutoFill Destination:=Range(Cells(myRow, mycolumn), Cells(myRow + 5, mycolumn + 7)), Type:=xlFillDefault
ElseIf icellcount = mycellcount Then 'when icellcount is end
'enter descriptive stats for last cell
'enter "Cell" header and cell number
Cells(mylastrow + 35 + ((icellcount - 1) * 7), 5).Select
ActiveCell.Value = icellcount
'get row and column numbers
Cells(mylastrow + 35 + ((icellcount - 1) * 7), 6).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
'enter count, average, stdev, sem, min, max
Cells(myRow, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Count"
Cells(myRow + 1, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Average"
Cells(myRow + 2, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Stdev"
Cells(myRow + 3, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events SEM"
Cells(myRow + 4, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events MIN"
Cells(myRow + 5, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events MAX"
'compute the descriptive statistics
'compute count,ave,stdev,sem
Cells(mylastrow + 35 + ((icellcount - 1) * 7), 7).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
Cells(myRow, mycolumn).Select
ActiveCell.Value = "=COUNT(" & "G" & myCellarray(icellcount - 1) & ":G" & mylastrow & ")"
Cells(myRow + 1, mycolumn).Select
ActiveCell.Value = "=AVERAGE(" & "G" & myCellarray(icellcount - 1) & ":G" & mylastrow & ")"
Cells(myRow + 2, mycolumn).Select
ActiveCell.Value = "=STDEV(" & "G" & myCellarray(icellcount - 1) & ":G" & mylastrow & ")"
Cells(myRow + 3, mycolumn).Select
ActiveCell.FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
Cells(myRow + 4, mycolumn).Select
ActiveCell.Value = "=MIN(" & "G" & myCellarray(icellcount - 1) & ":G" & mylastrow & ")"
Cells(myRow + 5, mycolumn).Select
ActiveCell.Value = "=MAX(" & "G" & myCellarray(icellcount - 1) & ":G" & mylastrow & ")"
'populate all columns with count, ave, Std, SEM
Range(Cells(myRow, mycolumn), Cells(myRow + 5, mycolumn)).Select
Selection.AutoFill Destination:=Range(Cells(myRow, mycolumn), Cells(myRow + 5, mycolumn + 7)), Type:=xlFillDefault
'ENTER SUMMARY DESCRIPTIVE STATS
'enter "Cell" header and cell number
Cells(mylastrow + 35 + ((icellcount) * 7), 5).Activate
ActiveCell.Value = "Total"
Selection.Font.Bold = True
'get row and column numbers
Cells(mylastrow + 35 + ((icellcount) * 7), 6).Activate
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
'enter count, average, stdev, sem, min, max
Cells(myRow, mycolumn).Activate
ActiveCell.Value = "Events Count"
Selection.Font.Bold = True
Cells(myRow + 1, mycolumn).Activate
ActiveCell.Value = "Events Average"
Selection.Font.Bold = True
Cells(myRow + 2, mycolumn).Activate
ActiveCell.Value = "Events Stdev"
Selection.Font.Bold = True
Cells(myRow + 3, mycolumn).Activate
ActiveCell.Value = "Events SEM"
Selection.Font.Bold = True
Cells(myRow + 4, mycolumn).Activate
ActiveCell.Value = "Events MIN"
Selection.Font.Bold = True
Cells(myRow + 5, mycolumn).Activate
ActiveCell.Value = "Events MAX"
Selection.Font.Bold = True
'compute the descriptive statistics
'compute count,ave,stdev,sem,min,max
'loop through all values add and divide by total number
'need to loop through each average parameter statistic and each metric 6x7 = 42 entries
For icountrow = 0 To 5 'spans six stats
For icountcol = 0 To 6 'spans seven parameters, not frequency
Cells(mylastrow + 35 + ((icellcount) * 7), 7).Activate
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
Cells(myRow + icountrow, mycolumn + icountcol).Activate 'shift to new cell
'compute average
myAverage = 0
For iavecount = 1 To mycellcount
avetempval = Range(ActiveCell, ActiveCell).Offset(-7 * (iavecount + 1), 0).Value 'start counnting 2x7 cells away
myAverage = myAverage + avetempval
Next iavecount
myAverage = (myAverage / mycellcount)
ActiveCell.Value = myAverage
Next icountcol
Next icountrow
Else 'when icellcount is not 1 or end
'enter "Cell" header and cell number
Cells(mylastrow + 35 + ((icellcount - 1) * 7), 5).Select
ActiveCell.Value = icellcount
'get row and column numbers
Cells(mylastrow + 35 + ((icellcount - 1) * 7), 6).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
'enter count, average, stdev, sem, min, max
Cells(myRow, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Count"
Cells(myRow + 1, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Average"
Cells(myRow + 2, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events Stdev"
Cells(myRow + 3, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events SEM"
Cells(myRow + 4, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events MIN"
Cells(myRow + 5, mycolumn).Select
ActiveCell.FormulaR1C1 = "Events MAX"
'compute the descriptive statistics
'compute count,ave,stdev,sem
Cells(mylastrow + 35 + ((icellcount - 1) * 7), 7).Select
myRow = ActiveCell.Row
mycolumn = ActiveCell.Column
Cells(myRow, mycolumn).Select
ActiveCell.Value = "=COUNT(" & "G" & myCellarray(icellcount - 1) & ":G" & myCellarray(icellcount) - 1 & ")"
Cells(myRow + 1, mycolumn).Select
ActiveCell.Value = "=AVERAGE(" & "G" & myCellarray(icellcount - 1) & ":G" & myCellarray(icellcount) - 1 & ")"
Cells(myRow + 2, mycolumn).Select
ActiveCell.Value = "=STDEV(" & "G" & myCellarray(icellcount - 1) & ":G" & myCellarray(icellcount) - 1 & ")"
Cells(myRow + 3, mycolumn).Select
ActiveCell.FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
Cells(myRow + 4, mycolumn).Select
ActiveCell.Value = "=MIN(" & "G" & myCellarray(icellcount - 1) & ":G" & myCellarray(icellcount) - 1 & ")"
Cells(myRow + 5, mycolumn).Select
ActiveCell.Value = "=MAX(" & "G" & myCellarray(icellcount - 1) & ":G" & myCellarray(icellcount) - 1 & ")"
'populate all columns with count, ave, Std, SEM
Range(Cells(myRow, mycolumn), Cells(myRow + 5, mycolumn)).Select
Selection.AutoFill Destination:=Range(Cells(myRow, mycolumn), Cells(myRow + 5, mycolumn + 7)), Type:=xlFillDefault
End If
Next icellcount
Next ws
''Give more infor about Errors
'On Error GoTo ShowErrDescription
End Sub
''Show the extra error information
'ShowErrDescription:
'MsgBox Err.Description
Compute Averge of per cell averages
back to top
Sub AverageofAverage()
'
'
Dim icountcol As Integer
Dim mycellcount As Integer
Dim icellcount As Integer
Dim iCount As Integer
'Inex through all worksheets
For Each ws In Worksheets
ws.Select
'check if there is only one chart in current worksheet
iCount = ws.ChartObjects.Count
'if no chart found in sheet then should be only data, get averages
If iCount = 0 Then
'Go to column containing cell number, end of column value is total number of cells
Range(Cells(3, 6), Cells(3, 6)).Select
Selection.End(xlDown).Select
'total number of unique cells
icellcount = Selection.Value
mycellcount = icellcount
'Get last row
mylastrow = ActiveCell.Row
'Copy and paste column headers
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Cells(mylastrow + 35 + ((icellcount + 1) * (7)), 7).Select
ActiveSheet.Paste
'enter totals header
Cells(mylastrow + 35 + ((icellcount + 1) * (7)), 5).Activate
ActiveCell.Value = "Cell Averages Filtered"
Selection.Font.Bold = True
'enter averages header
' Cells(mylastrow + 35 + ((icellcount + 1) * (7) + 1), 6).Activate
' ActiveCell.Value = "Averages"
' Selection.Font.Bold = True
'compute the descriptive statistics
'compute count,ave,stdev,sem,min,max
'need to loop through all cell averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7) + 1), 7 + icountcol).Activate
For iavecount = 1 To mycellcount 'spans each individual cell
'MsgBox "starting here"
myAverageval = Range(ActiveCell.Offset(-7 * (iavecount + 1), 0), ActiveCell.Offset(-7 * (iavecount + 1), 7)).Copy 'jump up to cell given by (28-iavecount+1), make sure to skip the group entry above, which is the average of the average
'MsgBox "copied this"
'MsgBox "pasting here"
Range(ActiveCell.Offset(iavecount - 1, 0), ActiveCell.Offset(iavecount - 1, 7)).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False 'shift down to enter copied contents
'MsgBox "pasted"
Range(ActiveCell, ActiveCell).Offset(-(iavecount - 1), 0).Activate 'PasteSpecial will activate cell, need to move back home
'MsgBox "Back home"
Next iavecount
End If
Next ws
''Give more infor about Errors
'On Error GoTo ShowErrDescription
End Sub
''Show the extra error information
'ShowErrDescription:
'MsgBox Err.Description
Generate and Format Histograms
back to top
Sub MakeHistos_ALL()
Call makeHistos_1_Amp
Call makeHistos_2_Tau_Rise
Call makeHistos_3_Tau_Decay
Call makeHistos_4_Charge
Call makeHistos_5_Freq
Call formatHistos_1_AMP
Call formatHistos_2_Tau_Rise
Call formatHistos_3_Tau_Decay
Call formatHistos_4_Charge
Call formatHistos_5_Freq
End Sub
Amplitude Histogram
back to top
Sub makeHistos_1_Amp()
Dim myGroup As String
Dim myName As String
Dim myBinRange As String
Dim myDataRange As String
Dim ws As Worksheet
Dim userinput As Integer
Dim cValue As Single
Dim rThresh As Single
Dim mymean As Single
Dim mystdev As Single
Dim xValtemp As Single
Dim Ncells As Single
Dim myTitle(1 To 6) As String
myTitle(1) = "Amplitude"
myTitle(2) = "Tau_Rise"
myTitle(3) = "Tau_Decay"
myTitle(4) = "Charge"
myTitle(5) = "Inter_Peak_Interval"
myTitle(6) = "Freq"
'User input. Filter before plotting histogram ? Otherwise plot unfiltered data
'Filtering based on interquartile length, 1.5*interquartile length
userinput = Ask_Question() '6=Yes, 7=No
'Inex through all worksheets
For Each ws In Worksheets
ws.Select
'Count objects in ActiveSheet
iCount = ws.ChartObjects.Count
'if no chart found then adjust the representation
If iCount = 0 Then
'Go to column containing cell number, end of column value is total number of cells
Range(Cells(3, 6), Cells(3, 6)).Select
Selection.End(xlDown).Select
'total number of unique cells
icellcount = Selection.Value
mycellcount = icellcount
'Get last row
mylastrow = ActiveCell.Row
'Copy Column Headers
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 1), 7).Activate
ActiveSheet.Paste
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 7).Activate
ActiveSheet.Paste
'Generate the Descriptive Stats
'Populate Headers for descriptive Stats
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5).Value = "Averge of Cell Averages Filtered"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 6).Value = "Count"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 6).Value = "Average"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 6).Value = "Stdev"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), 6).Value = "SEM"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), 6).Value = "Min"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6).Value = "Max"
'Populate Descriptive Stats with Values
ColumnCount = 7
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)) + 1, ColumnCount).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'Go to Descriptive Stats and Populate Values
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), ColumnCount).Value = "=Count(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), ColumnCount).Value = "=Average(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), ColumnCount).Value = "=Stdev(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), ColumnCount).FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), ColumnCount).Value = "=MIN(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), ColumnCount).Value = "=MAX(" & myDataRange & ")"
'Enter Bin Header
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 6).Value = "Bin"
'Generate Bin Valuse for EPC AMPLITUDE OR MEP AMPLITUDE
If InStr(ActiveSheet.Name, "EPC") Then
'Generate Bin Values for EPC AMPLITUDE
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 7).Value = "0.05"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 7).Value = "0.1"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 7).Value = "0.15"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 7).Value = "0.20"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 7).Value = "0.25"
'Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 7).Value = "0.30"
ElseIf InStr(ActiveSheet.Name, "MEP") Then
'Generate Bin Valuse for MEP AMPLITUDE
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 7).Value = "0.4"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 7).Value = "0.8"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 7).Value = "1.2"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 7).Value = "1.6"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 7).Value = "2.0"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 7).Value = "2.4"
'Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 16), 7).Value = "2.8"
'Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 17), 7).Value = "3.2"
End If
'Use the Histogram Application to Generate Histogram using Averages and Bin
'Get name of title
myName = Right(ActiveSheet.Name, 9)
myName = myTitle(1) & "_" & myName
'MsgBox myName
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)), 7).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'MsgBox myDataRange
'Get the Range of Data Bins
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 7).Select
Range(Selection, Selection.End(xlDown)).Select
myBinRange = Selection.Address
'MsgBox myBinRange
'Filter Data, after having created range selection, because filtering might create gaps in column of row data
'Filter Data if Yes(6)
If userinput = 6 Then
'calculate the criticalvalue
Ncells = icellcount
cValue = Critical_Value(0.05, Ncells)
'calculate the rejection threshold value
rThresh = reject_Thresh(cValue, Ncells)
'copy average,stdev
mymean = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 7).Value 'amplitude
mystdev = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 7).Value 'amplitude
'loop through each row value for column data
For RowCount = 1 To icellcount
'Determine if current value is an outlier
xValtemp = Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 7).Value
xFilt = reject_X(xValtemp, mymean, mystdev, rThresh)
'If value is an outlier, then remove it, update later make hidden
If xFilt = 1 Then
Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 7).Value = ""
End If
Next RowCount
End If
'Run Histogram application on current parameter
Application.Run "Histogram", Range(myDataRange) _
, myName, Range(myBinRange), False, False _
, True, True
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 7)).Copy 'amplitude
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 4).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
End If
Next ws
''Give more infor about Errors
'On Error GoTo ShowErrDescription
End Sub
''Show the extra error information
'ShowErrDescription:
'MsgBox Err.Description
Tau Rise Histogram
back to top
Sub makeHistos_2_Tau_Rise()
Dim myGroup As String
Dim myName As String
Dim myBinRange As String
Dim myDataRange As String
Dim ws As Worksheet
Dim userinput As Integer
Dim cValue As Single
Dim rThresh As Single
Dim mymean As Single
Dim mystdev As Single
Dim xValtemp As Single
Dim Ncells As Single
Dim myTitle(1 To 6) As String
myTitle(1) = "Amplitude"
myTitle(2) = "Tau_Rise"
myTitle(3) = "Tau_Decay"
myTitle(4) = "Charge"
myTitle(5) = "Inter_Peak_Interval"
myTitle(6) = "Freq"
'User input. Filter before plotting histogram ? Otherwise plot unfiltered data
'Filtering based on interquartile length, 1.5*interquartile length
userinput = Ask_Question() '6=Yes, 7=No
'Inex through all worksheets
For Each ws In Worksheets
ws.Select
'Count objects in ActiveSheet
iCount = ws.ChartObjects.Count
'if no chart found then adjust the representation
If iCount = 0 Then
'Go to column containing cell number, end of column value is total number of cells
Range(Cells(3, 6), Cells(3, 6)).Select
Selection.End(xlDown).Select
'total number of unique cells
icellcount = Selection.Value
mycellcount = icellcount
'Get last row
mylastrow = ActiveCell.Row
'Copy Column Headers
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 1), 7).Activate
ActiveSheet.Paste
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 7).Activate
ActiveSheet.Paste
'Generate the Descriptive Stats
'Populate Headers for descriptive Stats
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5).Value = "Averge of Cell Averages Filtered"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 6).Value = "Count"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 6).Value = "Average"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 6).Value = "Stdev"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), 6).Value = "SEM"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), 6).Value = "Min"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6).Value = "Max"
'Populate Descriptive Stats with Values
ColumnCount = 8
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)) + 1, ColumnCount).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'Go to Descriptive Stats and Populate Values
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), ColumnCount).Value = "=Count(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), ColumnCount).Value = "=Average(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), ColumnCount).Value = "=Stdev(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), ColumnCount).FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), ColumnCount).Value = "=MIN(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), ColumnCount).Value = "=MAX(" & myDataRange & ")"
'Enter Bin Header
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 6).Value = "Bin"
'Generate Bin Valuse for EPC Tau-Rise OR MEP Tau-Rise
If InStr(ActiveSheet.Name, "EPC") Then
'Generate Bin Values for EPC Tau-Rise
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 8).Value = "0.0003"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 8).Value = "0.00045"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 8).Value = "0.0006"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 8).Value = "0.00075"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 8).Value = "0.0009"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 8).Value = "0.00105"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 16), 8).Value = "0.0012"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 17), 8).Value = "0.00135"
'Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 18), 8).Value = "0.0015"
'Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 19), 8).Value = "0.0020"
'Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 20), 8).Value = "0.0030"
ElseIf InStr(ActiveSheet.Name, "MEP") Then
'Generate Bin Values for MEP Tau-Rise
'Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 8).Value = "0.0004"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 8).Value = "0.00006"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 8).Value = "0.0008"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 8).Value = "0.0010"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 8).Value = "0.0012"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 8).Value = "0.0014"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 16), 8).Value = "0.0016"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 17), 8).Value = "0.0018"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 18), 8).Value = "0.0020"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 19), 8).Value = "0.0100"
'Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 20), 8).Value = "0.0150"
End If
'Use the Histogram Application to Generate Histogram using Averages and Bin
'Get name of title
myName = Right(ActiveSheet.Name, 9)
myName = myTitle(2) & "_" & myName
'MsgBox myName
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)), 8).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'MsgBox myDataRange
'Get the Range of Data Bins
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 8).Select
Range(Selection, Selection.End(xlDown)).Select
myBinRange = Selection.Address
'MsgBox myBinRange
'Filter Data, after having created range selection, because filtering might create gaps in column of row data
'Filter Data if Yes
If userinput = 6 Then
'calculate the criticalvalue
Ncells = icellcount
cValue = Critical_Value(0.05, Ncells)
'calculate the rejection threshold value
rThresh = reject_Thresh(cValue, Ncells)
'copy average,stdev
mymean = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 8).Value 'amplitude
mystdev = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 8).Value 'amplitude
'loop through each row value for column data
For RowCount = 1 To icellcount
'Determine if current value is an outlier
xValtemp = Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 8).Value
xFilt = reject_X(xValtemp, mymean, mystdev, rThresh)
'If value is an outlier, then remove it, update later make hidden
If xFilt = 1 Then
Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 8).Value = ""
End If
Next RowCount
End If
'Run Histogram application on current parameter determined by column
Application.Run "Histogram", Range(myDataRange) _
, myName, Range(myBinRange), False, False _
, True, True
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat Header
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6)).Copy
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 4).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat Value
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 8), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 8)).Copy
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 6).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
End If
Next ws
End Sub
Tau Decay Histogram
back to top
Sub makeHistos_3_Tau_Decay()
Dim myGroup As String
Dim myName As String
Dim myBinRange As String
Dim myDataRange As String
Dim ws As Worksheet
Dim userinput As Integer
Dim cValue As Single
Dim rThresh As Single
Dim mymean As Single
Dim mystdev As Single
Dim xValtemp As Single
Dim Ncells As Single
Dim myTitle(1 To 6) As String
myTitle(1) = "Amplitude"
myTitle(2) = "Tau_Rise"
myTitle(3) = "Tau_Decay"
myTitle(4) = "Charge"
myTitle(5) = "Inter_Peak_Interval"
myTitle(6) = "Freq"
'User input. Filter before plotting histogram ? Otherwise plot unfiltered data
'Filtering based on interquartile length, 1.5*interquartile length
userinput = Ask_Question() '6=Yes, 7=No
'Inex through all worksheets
For Each ws In Worksheets
ws.Select
'Count objects in ActiveSheet
iCount = ws.ChartObjects.Count
'if no chart found then adjust the representation
If iCount = 0 Then
'Go to column containing cell number, end of column value is total number of cells
Range(Cells(3, 6), Cells(3, 6)).Select
Selection.End(xlDown).Select
'total number of unique cells
icellcount = Selection.Value
mycellcount = icellcount
'Get last row
mylastrow = ActiveCell.Row
'Copy Column Headers
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 1), 7).Activate
ActiveSheet.Paste
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 7).Activate
ActiveSheet.Paste
'Generate the Descriptive Stats
'Populate Headers for descriptive Stats
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5).Value = "Averge of Cell Averages Filtered"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 6).Value = "Count"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 6).Value = "Average"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 6).Value = "Stdev"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), 6).Value = "SEM"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), 6).Value = "Min"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6).Value = "Max"
'Populate Descriptive Stats with Values
ColumnCount = 9
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)) + 1, ColumnCount).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'Go to Descriptive Stats and Populate Values
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), ColumnCount).Value = "=Count(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), ColumnCount).Value = "=Average(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), ColumnCount).Value = "=Stdev(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), ColumnCount).FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), ColumnCount).Value = "=MIN(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), ColumnCount).Value = "=MAX(" & myDataRange & ")"
'Enter Bin Header
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 6).Value = "Bin"
'Generate Bin Valuse for EPC Tau-Rise OR MEP Tau-Rise
If InStr(ActiveSheet.Name, "EPC") Then
'Generate Bin Values for EPC Tau-Decay
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 9).Value = "0.0025"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 9).Value = "0.0030"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 9).Value = "0.0033"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 9).Value = "0.0036"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 9).Value = "0.0039"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 9).Value = "0.0042"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 16), 9).Value = "0.0045"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 17), 9).Value = "0.0048"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 18), 9).Value = "0.0051"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 19), 9).Value = "0.0070"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 20), 9).Value = "0.0110"
ElseIf InStr(ActiveSheet.Name, "MEP") Then
'Generate Bin Values for MEP Tau-Decay
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 9).Value = "0.0020"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 9).Value = "0.0030"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 9).Value = "0.0040"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 9).Value = "0.0045"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 9).Value = "0.0050"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 9).Value = "0.0055"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 16), 9).Value = "0.0060"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 17), 9).Value = "0.0065"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 18), 9).Value = "0.0080"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 19), 9).Value = "0.0100"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 20), 9).Value = "0.0400"
End If
'Use the Histogram Application to Generate Histogram using Averages and Bin
'Get name of title
myName = Right(ActiveSheet.Name, 9)
myName = myTitle(3) & "_" & myName
'MsgBox myName
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)), 9).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'MsgBox myDataRange
'Get the Range of Data Bins
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 9).Select
Range(Selection, Selection.End(xlDown)).Select
myBinRange = Selection.Address
'MsgBox myBinRange
'Filter Data, after having created range selection, because filtering might create gaps in column of row data
'Filter Data if Yes
If userinput = 6 Then
'calculate the criticalvalue
Ncells = icellcount
cValue = Critical_Value(0.05, Ncells)
'calculate the rejection threshold value
rThresh = reject_Thresh(cValue, Ncells)
'copy average,stdev
mymean = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 9).Value 'amplitude
mystdev = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 9).Value 'amplitude
'loop through each row value for column data
For RowCount = 1 To icellcount
'Determine if current value is an outlier
xValtemp = Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 9).Value
xFilt = reject_X(xValtemp, mymean, mystdev, rThresh)
'If value is an outlier, then remove it, update later make hidden
If xFilt = 1 Then
Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 9).Value = ""
End If
Next RowCount
End If
'Run Histogram application on current parameter determined by column
Application.Run "Histogram", Range(myDataRange) _
, myName, Range(myBinRange), False, False _
, True, True
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat Header
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6)).Copy
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 4).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat Value
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 9), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 9)).Copy
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 6).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
End If
Next ws
End Sub
Charge Histogram
back to top
Sub makeHistos_4_Charge()
Dim myGroup As String
Dim myName As String
Dim myBinRange As String
Dim myDataRange As String
Dim ws As Worksheet
Dim userinput As Integer
Dim cValue As Single
Dim rThresh As Single
Dim mymean As Single
Dim mystdev As Single
Dim xValtemp As Single
Dim Ncells As Single
Dim myTitle(1 To 6) As String
myTitle(1) = "Amplitude"
myTitle(2) = "Tau_Rise"
myTitle(3) = "Tau_Decay"
myTitle(4) = "Charge"
myTitle(5) = "Inter_Peak_Interval"
myTitle(6) = "Freq"
'User input. Filter before plotting histogram ? Otherwise plot unfiltered data
'Filtering based on interquartile length, 1.5*interquartile length
userinput = Ask_Question() '6=Yes, 7=No
'Inex through all worksheets
For Each ws In Worksheets
ws.Select
'Count objects in ActiveSheet
iCount = ws.ChartObjects.Count
'if no chart found and current worksheet is EPC, area under curve for EPC = coulombs, then make histogram
If iCount = 0 And InStr(ActiveSheet.Name, "EPC") Then
'Go to column containing cell number, end of column value is total number of cells
Range(Cells(3, 6), Cells(3, 6)).Select
Selection.End(xlDown).Select
'total number of unique cells
icellcount = Selection.Value
mycellcount = icellcount
'Get last row
mylastrow = ActiveCell.Row
'Copy Column Headers
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 1), 7).Activate
ActiveSheet.Paste
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 7).Activate
ActiveSheet.Paste
'Generate the Descriptive Stats
'Populate Headers for descriptive Stats
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5).Value = "Averge of Cell Averages Filtered"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 6).Value = "Count"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 6).Value = "Average"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 6).Value = "Stdev"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), 6).Value = "SEM"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), 6).Value = "Min"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6).Value = "Max"
'Populate Descriptive Stats with Values
ColumnCount = 10
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)) + 1, ColumnCount).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'Go to Descriptive Stats and Populate Values
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), ColumnCount).Value = "=Count(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), ColumnCount).Value = "=Average(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), ColumnCount).Value = "=Stdev(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), ColumnCount).FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), ColumnCount).Value = "=MIN(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), ColumnCount).Value = "=MAX(" & myDataRange & ")"
'Enter Bin Header
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 6).Value = "Bin"
'Generate Bin Values for EPC Charge nA*sec, will convert to nA*msec in graphs
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 10).Value = "0.0001"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 10).Value = "0.0002"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 10).Value = "0.0003"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 10).Value = "0.0004"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 10).Value = "0.0005"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 10).Value = "0.0006"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 16), 10).Value = "0.0007"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 17), 10).Value = "0.0008"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 18), 10).Value = "0.0009"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 19), 10).Value = "0.0010"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 20), 10).Value = "0.0025"
'Use the Histogram Application to Generate Histogram using Averages and Bin
'Get name of title
myName = Right(ActiveSheet.Name, 9)
myName = myTitle(4) & "_" & myName
'MsgBox myName
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)), 10).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'MsgBox myDataRange
'Get the Range of Data Bins
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 10).Select
Range(Selection, Selection.End(xlDown)).Select
myBinRange = Selection.Address
'MsgBox myBinRange
'Filter Data, after having created range selection, because filtering might create gaps in column of row data
'Filter Data if Yes
If userinput = 6 Then
'calculate the criticalvalue
Ncells = icellcount
cValue = Critical_Value(0.05, Ncells)
'calculate the rejection threshold value
rThresh = reject_Thresh(cValue, Ncells)
'copy average,stdev
mymean = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 10).Value 'amplitude
mystdev = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 10).Value 'amplitude
'loop through each row value for column data
For RowCount = 1 To icellcount
'Determine if current value is an outlier
xValtemp = Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 10).Value
xFilt = reject_X(xValtemp, mymean, mystdev, rThresh)
'If value is an outlier, then remove it, update later make hidden
If xFilt = 1 Then
Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 10).Value = ""
End If
Next RowCount
End If
'Run Histogram application on current parameter determined by column
Application.Run "Histogram", Range(myDataRange) _
, myName, Range(myBinRange), False, False _
, True, True
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat Header
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6)).Copy
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 4).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat Value
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 10), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 10)).Copy
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 6).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
End If
Next ws
End Sub
Frequency Histogram
back to top
Sub makeHistos_5_Freq()
Dim myGroup As String
Dim myName As String
Dim myBinRange As String
Dim myDataRange As String
Dim ws As Worksheet
Dim userinput As Integer
Dim cValue As Single
Dim rThresh As Single
Dim mymean As Single
Dim mystdev As Single
Dim xValtemp As Single
Dim Ncells As Single
Dim myTitle(1 To 6) As String
myTitle(1) = "Amplitude"
myTitle(2) = "Tau_Rise"
myTitle(3) = "Tau_Decay"
myTitle(4) = "Charge"
myTitle(5) = "Inter_Peak_Interval"
myTitle(6) = "Freq"
'User input. Filter before plotting histogram ? Otherwise plot unfiltered data
'Filtering based on interquartile length, 1.5*interquartile length
userinput = Ask_Question() '6=Yes, 7=No
'Inex through all worksheets
For Each ws In Worksheets
ws.Select
'Count objects in ActiveSheet
iCount = ws.ChartObjects.Count
'if no chart found then adjust the representation
If iCount = 0 Then
'Go to column containing cell number, end of column value is total number of cells
Range(Cells(3, 6), Cells(3, 6)).Select
Selection.End(xlDown).Select
'total number of unique cells
icellcount = Selection.Value
mycellcount = icellcount
'Get last row
mylastrow = ActiveCell.Row
'Copy Column Headers
Range("G1").Select
Range("G1:N1").Select
Selection.Copy
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 1), 7).Activate
ActiveSheet.Paste
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 7).Activate
ActiveSheet.Paste
'Generate the Descriptive Stats
'Populate Headers for descriptive Stats
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5).Value = "Averge of Cell Averages Filtered"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 6).Value = "Count"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 6).Value = "Average"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 6).Value = "Stdev"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), 6).Value = "SEM"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), 6).Value = "Min"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6).Value = "Max"
'Populate Descriptive Stats with Values
ColumnCount = 14
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)) + 1, ColumnCount).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'Go to Descriptive Stats and Populate Values
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), ColumnCount).Value = "=Count(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), ColumnCount).Value = "=Average(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), ColumnCount).Value = "=Stdev(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 5), ColumnCount).FormulaR1C1 = "=R[-1]C/SQRT(R[-3]C)"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 6), ColumnCount).Value = "=MIN(" & myDataRange & ")"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), ColumnCount).Value = "=MAX(" & myDataRange & ")"
'Enter Bin Header
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 6).Value = "Bin"
'Generate Bin Valuse for EPC Frequency OR MEP Frequency
If InStr(ActiveSheet.Name, "EPC") Then
'Generate Bin Values for EPC Frequency
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 14).Value = "0.2"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 14).Value = "0.4"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 14).Value = "0.6"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 14).Value = "0.8"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 14).Value = "1.0"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 14).Value = "1.5"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 16), 14).Value = "2.0"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 17), 14).Value = "6"
'Go back to start of column number sequence and stretch numbers with excel autofilling
' Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 14).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.AutoFill Destination:=Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 14), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10 + 7), 14)), Type:=xlFillDefault
ElseIf InStr(ActiveSheet.Name, "MEP") Then
'Generate Bin Valuse for MEP Frequency
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 14).Value = "0.2"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 11), 14).Value = "0.4"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 12), 14).Value = "0.6"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 13), 14).Value = "0.8"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 14), 14).Value = "1.0"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 15), 14).Value = "1.5"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 16), 14).Value = "2.0"
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 17), 14).Value = "5"
'Go back to start of column number sequence and stretch numbers with excel autofilling
' Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 14).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.AutoFill Destination:=Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10), 14), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 10 + 7), 14)), Type:=xlFillDefault
End If
'Use the Histogram Application to Generate Histogram using Averages and Bin
'Get name of title
myName = Right(ActiveSheet.Name, 9)
myName = myTitle(6) & "_" & myName
'MsgBox myName
'Get the Range of Data Averages
Cells(mylastrow + 35 + ((icellcount + 1) * (7)), 14).Select
Range(Selection, Selection.End(xlDown)).Select
myDataRange = Selection.Address
'MsgBox myDataRange
'Get the Range of Data Bins
Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 9), 14).Select
Range(Selection, Selection.End(xlDown)).Select
myBinRange = Selection.Address
'MsgBox myBinRange
'Filter Data, after having created range selection, because filtering might create gaps in column of row data
'Filter Data if Yes
If userinput = 6 Then
'calculate the criticalvalue
Ncells = icellcount
cValue = Critical_Value(0.05, Ncells)
'calculate the rejection threshold value
rThresh = reject_Thresh(cValue, Ncells)
'copy average,stdev
mymean = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 3), 14).Value 'amplitude
mystdev = Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 4), 14).Value 'amplitude
'loop through each row value for column data
For RowCount = 1 To icellcount
'Determine if current value is an outlier
xValtemp = Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 14).Value
xFilt = reject_X(xValtemp, mymean, mystdev, rThresh)
'If value is an outlier, then remove it, update later make hidden
If xFilt = 1 Then
Cells(mylastrow + 35 + ((icellcount + 1) * (7) + RowCount), 14).Value = ""
End If
Next RowCount
End If
'Run Histogram application on current parameter determined by column
Application.Run "Histogram", Range(myDataRange) _
, myName, Range(myBinRange), False, False _
, True, True
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat Header
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 5), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 6)).Copy
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 4).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
'Copy the Descriptive Stat Value
Range(Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 2), 14), Cells(mylastrow + 35 + ((icellcount + 1) * (8) + 7), 14)).Copy
'Go back to chart and paste data
ActiveSheet.Previous.Select
Cells(17, 6).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Return to Data Sheet
ActiveSheet.Next.Select
End If
Next ws
''Give more infor about Errors
'On Error GoTo ShowErrDescription
End Sub
''Show the extra error information
'ShowErrDescription:
'MsgBox Err.Description
Format Histograms
back to top
Sub format1Histo()
'set bin number text/numerical representation format
currentSheetName = ActiveSheet.Name
Columns("A:A").ColumnWidth = 30
Columns("B:B").ColumnWidth = 10
Range("A2:A22").Select
Selection.NumberFormat = "0.0000"
'activate chart object
ActiveSheet.ChartObjects("Chart 1").Activate
'clear legend if it exists
If ActiveChart.HasLegend = True Then
ActiveChart.Legend.Select
Selection.Delete
End If
'set title to current sheet name
ActiveChart.ChartTitle.Text = currentSheetName
ActiveChart.ChartTitle.Select
Selection.Font.Size = 14
Selection.Font.Name = "Arial"
Selection.Font.Bold = True
ActiveChart.SeriesCollection(1).Interior.Color = RGB(0, 0, 0)
'scale the width and height of chart object
ActiveChart.ChartArea.Top = 15
ActiveChart.ChartArea.Height = 165
ActiveChart.ChartArea.Width = 280
ActiveChart.ChartArea.Border.Weight = 1
ActiveChart.ChartArea.Border.LineStyle = 0
'scale the width and height of plot inside chart object
ActiveChart.PlotArea.Top = 20
ActiveChart.PlotArea.Left = 12
ActiveChart.PlotArea.Height = 130
ActiveChart.PlotArea.Width = 260
ActiveChart.PlotArea.Border.Weight = 1
ActiveChart.PlotArea.Border.LineStyle = 0
'set the font/text format for x-axis
ActiveChart.Axes(xlCategory, xlPrimary).TickLabels.Font.Size = 8
ActiveChart.Axes(xlCategory, xlPrimary).TickLabels.Font.Name = "Arial"
ActiveChart.Axes(xlCategory, xlPrimary).TickLabels.Font.Bold = False
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Select
Selection.Font.Size = 12
Selection.Font.Name = "Arial"
Selection.Font.Bold = True
'set font/text format for y-axis
ActiveChart.Axes(xlValue, xlPrimary).TickLabels.Font.Size = 8
ActiveChart.Axes(xlValue, xlPrimary).TickLabels.Font.Name = "Arial"
ActiveChart.Axes(xlValue, xlPrimary).TickLabels.Font.Bold = False
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Select
Selection.Font.Size = 12
Selection.Font.Name = "Arial"
Selection.Font.Bold = True
''Give more infor about Errors
'On Error GoTo ShowErrDescription
End Sub
''Show the extra error information
'ShowErrDescription:
'MsgBox Err.Description
Remove All Charts
back to top
Sub DeleteAllCharts()
Dim currentSheetName As String
Dim mySheet As Worksheet
Dim iCount As Integer
'disable application warnings
Application.DisplayAlerts = False
'Inex through all worksheets
For Each ws In Worksheets
'check if there is only one chart in current worksheet
iCount = ws.ChartObjects.Count
'if no chart found in sheet then should be only data, get averages
If iCount = 1 Then
ws.Delete
End If
Next ws
'enable application warnings
Application.DisplayAlerts = True
End Sub
Dialog, question
back to top
Public Function Ask_Question() As Integer
'
'Function for Generating the Dialog Box
'Generate a dialog box requesting user input
Ask_Question = MsgBox(prompt:="Data Processing Before Plotting Histogram", Buttons:=vbYesNo, Title:="Filter Data ?")
End Function
Compute critical value
back to top
Public Function Critical_Value(alpha As Single, N As Single) As Single
'
'alpha = confidence interval, N = sample population size
'Calculate the critical value using excel TINV function
Critical_Value = WorksheetFunction.TInv(alpha, N)
End Function
Filter outliers 1
back to top
Public Function reject_Thresh(cValue As Single, rtCount As Single) As Single
'
'cValue = students t-test critical value, rtCount = sample pop size
'Calculate the rejection threshold value, based on interquartile length away from 3rd quartile for max extreme and 1st quartile for min extreme outliers
reject_Thresh = cValue * (rtCount - 1) / ((rtCount) ^ 0.5 * (rtCount - 2 + cValue ^ 2) ^ 0.5)
End Function
Filter outliers 2
back to top
Public Function reject_X(xValue As Single, xMean As Single, sValue As Single, xThresh As Single) As Integer
'
'xValue = single sample, xMean = sample pop mean, sValue = standard deviation of sample pop
'calculate the rejection value for a single sample from population with mean
x_compare = Abs(xValue - xMean) / sValue
If x_compare > xThresh Then
reject_X = 1
Else
reject_X = 0
End If
End Function