Thank you in advance for your help. My original code without the LGDCategory variable/input works but when try to add the additional variable LGDCategory the code is returning #value. Any thoughts how to fix this? The actual code is very long with many ifthen statements. If you need additional information please let me know. Thank you again.
Option Explicit
Option Compare Text
Function Default(RiskCategory As String, LGDCategory As String, Rating As String, Duration As Double)
SDuration2 = WorksheetFunction.Max(1, Duration)
Dim Duration_rounded_up As Double, Duration_rounded_down As Double
Duration_rounded_up = WorksheetFunction.RoundUp(Duration, 0)
Duration_rounded_down = WorksheetFunction.RoundDown(Duration, 0)
Dim PDCumulative As Double
If RiskCategory = "Corporate" And LGDCategory = "1stLienBond" Then
If Rating = "AAA" Then
If SDuration2 >= 1 And SDuration2 < 2 Then
PDCumulative = (0.000102 - 0) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 1) + 0
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 2 And SDuration2 < 3 Then
PDCumulative = (0.000102 - 0.000102) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 2) + 0.000102
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 3 And SDuration2 < 4 Then
PDCumulative = (0.00029 - 0.000102) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 3) + 0.000102
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 4 And SDuration2 < 5 Then
PDCumulative = (0.000801 - 0.00029) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 4) + 0.00029
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 5 And SDuration2 < 6 Then
PDCumulative = (0.001296 - 0.000801) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 5) + 0.000801
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 6 And SDuration2 < 7 Then
PDCumulative = (0.001815 - 0.001296) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 6) + 0.001296
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 7 And SDuration2 < 8 Then
PDCumulative = (0.002362 - 0.001815) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 7) + 0.001815
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 8 And SDuration2 < 9 Then
PDCumulative = (0.002937 - 0.002362) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 8) + 0.002362
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 9 And SDuration2 < 10 Then
PDCumulative = (0.003543 - 0.002937) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 9) + 0.002937
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 10 And SDuration2 < 11 Then
PDCumulative = (0.004182 - 0.003543) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 10) + 0.003543
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 11 And SDuration2 < 12 Then
PDCumulative = (0.004854 - 0.004182) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 11) + 0.004182
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 12 And SDuration2 < 13 Then
PDCumulative = (0.005535 - 0.004854) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 12) + 0.004854
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 13 And SDuration2 < 14 Then
PDCumulative = (0.005915 - 0.005535) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 13) + 0.005535
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 14 And SDuration2 < 15 Then
PDCumulative = (0.00632 - 0.005915) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 14) + 0.005915
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 15 And SDuration2 < 16 Then
PDCumulative = (0.00675 - 0.00632) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 15) + 0.00632
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 16 And SDuration2 < 17 Then
PDCumulative = (0.007206 - 0.00675) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 16) + 0.00675
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 17 And SDuration2 < 18 Then
PDCumulative = (0.007365 - 0.007206) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 17) + 0.007206
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 18 And SDuration2 < 19 Then
PDCumulative = (0.007365 - 0.007365) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 18) + 0.007365
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 19 And SDuration2 < 20 Then
PDCumulative = (0.007365 - 0.007365) / (Duration_rounded_up - Duration_rounded_down) * (Duration - 19) + 0.007365
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 19 And SDuration2 < 20 Then
PDCumulative = 0.007365
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
ElseIf SDuration2 >= 20 And SDuration2 < 50 Then
PDCumulative = 1 - (1 - 0.007365) * ((1 - 0.007365) / (1 - 0.007365)) ^ (Duration - 20)
Default = -(1 - (1 - PDCumulative) ^ (1 / Duration)) * 0.45396 * 10000
End If
End If
End If
Private Sub BTNP1_Click(sender As Object, e As EventArgs) Handles BTNP1.Click
RollDice() 'dice rolling sub'
P1Pos = P1Pos + Dice + 1 'decides position based on dice roll'
Label1.Text = P1Pos
If P1Pos < 10 Then
P1x = 214 + (P1Pos * 60) 'Gets position and moves the PB (of size 60px) another 60px along from side'
P1Point = New Point(P1x, 570) 'Creates a new point with the new x value'
PBP1.Location = P1Point 'changes the location of the picture box'
ElseIf P1Pos > 9 And P1Pos < 20 Then
P1x = 754 - ((P1Pos - 10) * 60)
P1Point = New Point(P1x, 510)
PBP1.Location = P1Point
ElseIf P1Pos > 19 And P1Pos < 30 Then
P1x = 214 + ((P1Pos - 20) * 60)
P1Point = New Point(P1x, 450)
PBP1.Location = P1Point
ElseIf P1Pos > 29 And P1Pos < 40 Then
P1x = 754 - ((P1Pos - 30) * 60)
P1Point = New Point(P1x, 390)
PBP1.Location = P1Point
ElseIf P1Pos > 39 And P1Pos < 50 Then
P1x = 214 + ((P1Pos - 40) * 60)
P1Point = New Point(P1x, 330)
PBP1.Location = P1Point
ElseIf P1Pos > 49 And P1Pos < 60 Then
P1x = 754 - ((P1Pos - 50) * 60)
P1Point = New Point(P1x, 260)
PBP1.Location = P1Point
ElseIf P1Pos > 59 And P1Pos < 70 Then
P1x = 214 + ((P1Pos - 60) * 60)
P1Point = New Point(P1x, 200)
PBP1.Location = P1Point
ElseIf P1Pos > 69 And P1Pos < 80 Then
P1x = 754 - ((P1Pos - 70) * 60)
P1Point = New Point(P1x, 140)
PBP1.Location = P1Point
ElseIf P1Pos > 79 And P1Pos < 90 Then
P1x = 214 + ((P1Pos - 80) * 60)
P1Point = New Point(P1x, 80)
PBP1.Location = P1Point
ElseIf P1Pos > 89 And P1Pos < 94 Then
P1x = 754 - ((P1Pos - 90) * 60)
P1Point = New Point(P1x, 20)
PBP1.Location = P1Point
ElseIf P1Pos > 93 Then
P1Distance = 100 - P1Pos 'gets distance from end of board'
If P1Distance >= Dice + 1 Then 'aks if the distance is = or > the dice roll'
P1x = 754 - ((P1Pos - 90) * 60)
P1Point = New Point(P1x, 20)
PBP1.Location = P1Point
End If
End If
End Sub
my picture box character always stops at 94 or closer to 100 but never actually moves again once in this position. I'm trying to get the picture box to stay still unless it is able to move without exceeding 100. this is the only way I can think of doing it and it has worked in past iterations but I cannot get it to work here.
P.S. I can't use a different language because VB is required by my school for this project.
You could keep the checking for the game win separate from the movement of the player's piece.
Also, you could calculate the location of the player's piece, which would cut out many of the "magic numbers" used.
Option Strict On
Dim rand As New Random()
Dim P1Pos As Integer = -1
Private Function DieRoll() As Integer
' Return a random number from 1 to 6 inclusive.
Return rand.Next(1, 7)
End Function
Private Sub BTNP1_Click(sender As Object, e As EventArgs) Handles BTNP1.Click
Dim currentSquare = P1Pos
Dim numberRolled = DieRoll() ' 1..6
Dim provisionalSquare = currentSquare + numberRolled
If provisionalSquare <= 100 Then
currentSquare = provisionalSquare
Else
' Perhaps indicate that the number rolled was too high, so no move.
MessageBox.Show("Rolled too high!")
End If
If currentSquare = 100 Then
' I guess you want to do something here
Exit Sub
End If
P1Pos = currentSquare
Dim row = currentSquare \ 10
Dim col = currentSquare Mod 10
Dim direction = 1 - ((row Mod 2) * 2) ' ltr=1 rtl=-1
If direction = -1 Then
col = 9 - col
End If
Dim x = 214 + 60 * col
Dim y = 510 - 60 * row
PBP1.Location = New Point(x, y)
End Sub
The calculations for x and y are just what I guessed at from the code in the question.
If this is for homework, you need to make sure that you understand what is happening in the code and be able to explain it. Some study of what is going on using the debugger to watch the values of variables will go a long way to helping you with that and your future endeavours ;)
I compose a code ,which take "Samples" spreadsheeet with a depth database and displays the numbers in "Log"
Sub Log()
Dim i As Integer
For i = 1 To 4
Sheets("Samples").Select
Sheets("Log").Select
If Value <= 0.2 Then
ActiveSheet.Range("C9").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value < 0.4 And Value > 0.2 Then
ActiveSheet.Range("C10").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value <= 0.5 And Value >= 0.4 Then
ActiveSheet.Range("C11").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 0.5 And Value < 0.9 Then
ActiveSheet.Range("C12").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value < 1 And Value >= 0.9 Then
ActiveSheet.Range("C13").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 1 And Value < 1.2 Then
ActiveSheet.Range("C14").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 1.2 And Value <= 1.5 Then
ActiveSheet.Range("C15").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 1.5 And Value < 1.8 Then
ActiveSheet.Range("C16").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 1.7 And Value < 1.9 Then
ActiveSheet.Range("C17").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value >= 1.9 And Value < 2 Then
ActiveSheet.Range("C18").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 2 And Value < 2.2 Then
ActiveSheet.Range("C19").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value >= 2.2 And Value < 2.4 Then
ActiveSheet.Range("C20").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value >= 2.4 And Value <= 2.5 Then
ActiveSheet.Range("C21").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 2.5 And Value < 2.8 Then
ActiveSheet.Range("C22").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value >= 2.8 And Value < 3 Then
ActiveSheet.Range("C23").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 3 And Value < 3.2 Then
ActiveSheet.Range("C24").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value >= 3.2 And Value <= 3.5 Then
ActiveSheet.Range("C25").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 3.5 And Value < 3.7 Then
ActiveSheet.Range("C26").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value >= 3.7 And Value <= 3.9 Then
ActiveSheet.Range("C27").Value = Sheets("Samples").Range("B6").Offset(i - 1)
ElseIf Value > 3.9 And Value < 4 Then
ActiveSheet.Range("C28").Value = Sheets("Samples").Range("B6").Offset(i - 1)
End If
Next i
End Sub
spreadsheet, a depth scale.
The problem is that i use Offset and the loop does not work on the whole database. The loop stars on B6 until B13 on "Samples" spreadsheet.
Here is what I have done already
I have a VBA function (DecTime) that I call passing in the value of a cell. The cell is formatted as custom hh:mm
in my cell the formula is "=DecTime(M6)"
If M6 is a time, eg 01:05 then it works fine, if it is null then I get #VALUE!
I am sure it's a simple solution but having spent the last hour trying lots of things from here and google I am baffled!
Here is my function :
Function DecTime(Optional time As Date = #12:00:00 AM#) As Single 'String
Dim Hours As Integer
Dim Minutes As Single
Dim HoursStr As String
Dim arrTime
'On Error Resume Next
'On Error GoTo error_handler
' HoursStr = Format(time, "h:mm")
' DecTime = HoursStr
If time = #12:00:00 AM# Then
' If HoursStr = "12:00" Then
' If IsEmpty(time) Then
' If IsEmpty(time) = True Then
' If IsNull(time) Then
' If arrTime.Count = 0 Then
' If InStr(0, time, ":") = 0 Then
' If IsDate(time) = False Then
DecTime = 88
' DecTime = HoursStr
Else
arrTime = Split(time, ":")
If arrTime(1) <= 0 Then
Minutes = 0
ElseIf arrTime(1) <= 5 Then
Minutes = 0.1
ElseIf arrTime(1) <= 10 Then
Minutes = 0.2
ElseIf arrTime(1) <= 15 Then
Minutes = 0.3
ElseIf arrTime(1) <= 20 Then
Minutes = 0.3
ElseIf arrTime(1) <= 25 Then
Minutes = 0.4
ElseIf arrTime(1) <= 30 Then
Minutes = 0.5
ElseIf arrTime(1) <= 35 Then
Minutes = 0.6
ElseIf arrTime(1) <= 40 Then
Minutes = 0.7
ElseIf arrTime(1) <= 45 Then
Minutes = 0.8
ElseIf arrTime(1) <= 50 Then
Minutes = 0.8
ElseIf arrTime(1) <= 55 Then
Minutes = 0.9
Else
Minutes = 0
End If
Hours = arrTime(0)
DecTime = Hours + Minutes
' DecTime = HoursStr
End If
'error_handler:
' DecTime = 99
'Resume Next
End Function
As you can see from the remarked code I have tried lots of different options to deal with a blank parameter passed in so if someone can tell me what I've done wrong I'd be very greatful!
I am a sql programmer so not much experience with VB
Assuming you want to return 0 if the cell is empty or doesn't contain a date, you could use:
Function DecTime(Optional time = #12:00:00 AM#) As Double
Dim Hours As Integer
Dim Minutes As Single
Dim arrTime
If Not IsDate(time) Then
DecTime = 0
ElseIf time = #12:00:00 AM# Then
DecTime = 0
Else
arrTime = Split(time, ":")
Select Case arrTime(1)
Case Is = 0
Minutes = 0
Case Is <= 5
Minutes = 0.1
Case Is <= 10
Minutes = 0.2
Case Is <= 20
Minutes = 0.3
Case Is <= 25
Minutes = 0.4
Case Is <= 30
Minutes = 0.5
Case Is <= 35
Minutes = 0.6
Case Is <= 40
Minutes = 0.7
Case Is <= 50
Minutes = 0.8
Case Is <= 55
Minutes = 0.9
Case Else
Minutes = 0
End Select
Hours = arrTime(0)
DecTime = Hours + Minutes
End If
End Function
I am getting time as 23300000 i.e. hhMMssmm format as string
and I want to calculate difference of such two values.
Here hh is hours, MM is minutes, ss is seconds, and mm is 60th of second.
Using VBA for Excel 2003
This UDF will return the absolute value of the difference in seconds
Public Function tDiff(s1 As String, s2 As String) As Double
'
' calculates the absolute value of the differences
' returns the answer in seconds
'
Dim hrs As Double, mins As Double, secs As Double, sixt As Double
Dim tVal1 As Double, tVal2 As Double
hrs = CDbl(Mid(s1, 1, 2)) * 60 * 60
mins = CDbl(Mid(s1, 3, 2)) * 60
secs = CDbl(Mid(s1, 5, 2))
sixt = CDbl(Mid(s1, 7, 2)) / 60
tVal1 = hrs + mins + secs + sixt
hrs = CDbl(Mid(s2, 1, 2)) * 60 * 60
mins = CDbl(Mid(s2, 3, 2)) * 60
secs = CDbl(Mid(s2, 5, 2))
sixt = CDbl(Mid(s2, 7, 2)) / 60
tVal2 = hrs + mins + secs + sixt
If tVal1 > tVal2 Then
tDiff = tVal1 - tVal2
Else
tDiff = tVal2 - tVal1
End If
End Function
How about something like this:
Public Sub test()
Dim ms1 As Double
Dim ms2 As Double
ms1 = ToSeconds(23142700)
ms2 = ToSeconds(23311500)
Debug.Print "Difference between dates in seconds: " & ms2 - ms1
End Sub
Public Function ToSeconds(number As Long) As Double
Dim hh As Long
Dim mm As Long
Dim ss As Long
Dim ms As Long
ms = (number Mod (100 ^ 1)) / (100 ^ 0)
ss = (number Mod (100 ^ 2) - ms) / (100 ^ 1)
mm = (number Mod (100 ^ 3) - ss * (100 ^ 1) - ms) / (100 ^ 2)
hh = (number Mod (100 ^ 4) - mm * (100 ^ 2) - ss * (100 ^ 1) - ms) / (100 ^ 3)
ToSeconds = ms * 1 / 60 + ss + mm * 60 + hh * 60 * 60
End Function
The ToSeconds() function converts your number to seconds, and you can do your calculations based on that.
While this solution may not be as short as the others, I believe it is very easy to understand. Not everything here may be necessary, but you may find some of it useful in the future.
The run sub routine allows you to run the test function with your specified values.
The test function tests the timeDiff & timeSum logic.
The timeDiff function finds the time-difference between t1 and t0.
The timeSum function finds the time-sum of t1 and t0.
The asDuration function removes the AM/PM suffix from a time value.
The asMilitary function converts 12-hour format to 24 hour-format.
The concat function I created to more easily concatenate strings.
Sub Main() 'Run Test
MsgBox Test("0:29:0", "23:30:0")
End Sub
Function Test(startT As Date, endT As Date) 'Test timeDiff & timeSum logic
Dim nextShift As Date, prevShift As Date, hours As Date
hours = timeDiff(endT, startT)
prevShift = timeDiff(startT, "0:30:0")
nextShift = timeSum("0:30:0", endT)
Test = concat("Start -", startT, "", "End - ", endT, "", "Duration -", asDuration(hours), "", "Next Shift: ", nextShift, "", "Prev Shift: ", prevShift)
End Function
Function timeDiff(t1 As Date, t0 As Date) As Date 'Return Time1 minus Time0
Dim units(0 To 2) As String
units(0) = Hour(t1) - Hour(t0)
units(1) = Minute(t1) - Minute(t0)
units(2) = Second(t1) - Second(t0)
If units(2) < 0 Then
units(2) = units(2) + 60
units(1) = units(1) - 1
End If
If units(1) < 0 Then
units(1) = units(1) + 60
units(0) = units(0) - 1
End If
units(0) = IIf(units(0) < 0, units(0) + 24, units(0))
timeDiff = Join(units, ":")
End Function
Function timeSum(t1 As Date, t0 As Date) As Date 'Return Time1 plus Time0
Dim units(0 To 2) As String
units(0) = Hour(t1) + Hour(t0)
units(1) = Minute(t1) + Minute(t0)
units(2) = Second(t1) + Second(t0)
If units(2) >= 60 Then
units(2) = units(2) Mod 60
units(1) = units(1) + 1
End If
If units(1) >= 60 Then
units(1) = units(1) Mod 60
units(0) = units(0) + 1
End If
units(0) = IIf(units(0) >= 24, units(0) Mod 24, units(0))
timeSum = Join(units, ":")
End Function
Function asDuration(time As Date) As String 'Display as duration; Remove AM/PM suffix from time
time = asMilitary(time)
asDuration = Left(time, Len(time))
End Function
Function asMilitary(time As Date) As String 'Convert 12-hour format to 24-hour-format
asMilitary = Hour(time) & ":" & Minute(time) & ":" & Second(time)
End Function
Function concat(ParamArray var() As Variant) As String 'Return arguments of function call concatenated as a single string
For Each elem In var()
concat = IIf(elem <> "", concat & elem & " ", concat & vbNewLine)
Next
End Function