Attribute VB_Name = "Module121"
Dim modetype As String
Dim maxaccel As Double
Dim currow As Double
Sub RI()
Attribute RI.VB_Description = "Macro recorded 8/3/2004 by TESTING"
Attribute RI.VB_ProcData.VB_Invoke_Func = " \n14"
'  Calculate RI of a stretch
a = InputBox("give the Cell No of start event", , "a1")
b = InputBox("give the Cell No of last event", , "a48023")
c = MsgBox("This is for vertical acceleration?", vbYesNo + vbQuestion + vbDefaultButton1, , "", 0)
If c = vbYes Then
    c = "Vertical"
Else
    c = "Lateral"
End If
modetype = LCase(Left(Trim(c), 3))
Range(a).Select
peakRI = 0
peakcount = 0
maxaccel = 0
d = CDbl(Range(b).Row)
e = CDbl(ActiveCell.Row)
currow = 0
If Range(b).Value = Empty Then
a1 = MsgBox("Check the last cell", vbCritical, , "", 1)
Else
    While (e < d)
    peakRI = findpeak() + peakRI
    peakcount = peakcount + 1
    e = CDbl(ActiveCell.Offset(currow, 0).Row)
Wend
    peakRI = peakRI / peakcount
    peakRI = 0.896 * Exp(Log(peakRI) / 10)
    MsgBox ("RI value in " + CStr(c) + " mode is " + CStr(peakRI))
    MsgBox ("Max acceleration in " + CStr(c) + " mode is " + CStr(maxaccel))
    writecell ("RI=" + CStr(peakRI))
    ActiveCell.Offset(0, 1).Value = CStr(maxaccel) + " g"
    ActiveCell.Offset(0, 3).Value = CStr(a) + " to " + CStr(b)
End If
End Sub

Function findpeak() As Double
' calculate peak acceleration & time period of each half wave
maxval = 0
timeperiod = 0
x = ActiveCell.Offset(currow, 0).Value
While Abs(x) > 0 Or Not (x = Empty)
    x1 = ActiveCell.Offset(currow + 1, 0).Value
    timeperiod = timeperiod + 1
    currow = currow + 1
    If maxval < Abs(x1) Then
        maxval = Abs(x1)
    End If
    If (x1 >= 0 And x >= 0) Or (x1 < 0 And x < 0) Then
        x = x1
    Else
        x = 0
    End If
Wend
If maxaccel < maxval Then
    maxaccel = maxval
End If
maxval = 9.81 * 100 * maxval ' acceleration in cm/sec2
If timeperiod = 0 Then
    findpeak = 0
    currow = currow + 1
Else
    timeperiod = 1 / (2 * timeperiod * 0.01) ' sampling rate 100 samples/sec
    K = calK(CDbl(timeperiod))
    findpeak = K * maxval * maxval * maxval / timeperiod
End If
End Function
Function calK(x As Double) As Double
' find frequency dependant comfort factor
K = 0
If modetype = "lat" Then
    Select Case x
    Case 0 To 5
    K = x
    Case 5 To 5.4
    K = 0.8 * x * x
    Case 5.4 To 20
    K = 650 / (x * x)
    Case Else
    K = 0
    End Select
Else
Select Case x
    Case 0 To 0.5
    K = 0
    Case 0.55 To 5.4
    K = 0.325 * x * x
    Case 5.4 To 20
    K = 400 / (x * x)
    Case Else
    K = 0
    End Select
End If
calK = K
End Function
Function writecell(tex As String)
' write final values to workbook
Range("ak1").Select
While Not (ActiveCell.Value = "")
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Value = tex
ActiveCell.Offset(0, 2).Value = modetype
End Function