endcalc = (bWeight * ETFpEnd) + premium + cashEnding + CallDP + PutDP
End Function
------------------------------------------------
Sub CallStrikeProximityUp_Click()
Dim Nt As Variant
Nt = Range("j4").Value
Range("j4").Value = 0.0025 + Nt
End Sub
Sub RoundedRectangle7_Click()
Range("H8").Value = 10
End Sub
------------------------------------------------
Sub CallStrikeProximityUp_Click()
Dim Nt As Variant
Nt = Range("j4").Value
Range("j4").Value = 0.0025 + Nt
End Sub
Sub RoundedRectangle7_Click()
Range("H8").Value = 10
End Sub
------------------------------------------------
Function CalledYesNo(ETFprice As Currency, Stk As Currency, Called As String) As String
If Called = "Don't Sell" Then
CalledYesNo = "No"
ElseIf ETFprice < Stk Then
CalledYesNo = "No"
ElseIf ETFprice > Stk Then
CalledYesNo = "Yes"
End If
End Function
Function PutYesNo(ETFprice As Currency, Stk As Currency, Called As String) As String
If Called = "Don't Sell" Then
PutYesNo = "No"
ElseIf ETFprice > Stk Then
PutYesNo = "No"
ElseIf ETFprice < Stk Then
PutYesNo = "Yes"
End If
End Function
Function PutDamageFormula(ETFprice As Currency, Stk As Integer, Quantity As Integer, YesNo As String)
If YesNo = "Yes" Then
PutDamageFormula = (-1) * (Stk - ETFprice) * Quantity * 100
ElseIf YesNo = "No" Then
PutDamageFormula = 0
End If
End Function
Function PutStriker(ETFprice As Currency, PutInt As Variant)
Dim rndETFprice As Integer
If PutInt = "Don't Sell" Then GoTo zer
rndETFprice = Application.WorksheetFunction.RoundDown(ETFprice, 0)
PutStriker = Application.WorksheetFunction.RoundDown(rndETFprice - ((PutInt / 100) * rndETFprice), 0)
GoTo ext
zer:
PutStriker = 0
ext:
End Function
Function CallStriker(ETFprice As Currency, PutInt As Variant)
Dim rndETFprice As Integer
If PutInt = "Don't Sell" Then GoTo zer
rndETFprice = Application.WorksheetFunction.RoundDown(ETFprice, 0)
CallStriker = Application.WorksheetFunction.RoundDown(rndETFprice + ((PutInt / 100) * rndETFprice), 0)
GoTo ext
zer:
CallStriker = 0
ext:
End Function
------------------------------------------------
Function CallDestruction(ETFprice As Currency, Stk As Integer, Quantity As Integer, YesNo As String)
If YesNo = "Yes" Then
CallDestruction = -1 * (ETFprice - Stk) * Quantity * 100
ElseIf YesNo = "No" Then
CallDestruction = 0
End If
End Function
------------------------------------------------
Sub ConvertToString()
Dim vStr
vStr = 10000
MsgBox IsNumeric(strNum)
MsgBox IsNumeric(CStr(strNum))
End Sub
Sub xlDelCharts( _
Optional xlBookName As String, _
Optional xlSheetName As String, _
Optional InformUser As Boolean = True)
'
'****************************************************************************************
' Function deletes all embedded charts in the target worksheet
' Passed Values:
' xlBookName [in, string, OPTIONAL] target workbook; default = activeworkbook
' xlSheetName [in, string, OPTIONAL] target worksheet; default = activesheet
' InformUser [in, boolean, OPTIONAL] flag to indicate if user is to be
' informed of progress {default = TRUE}
'
'****************************************************************************************
'
Dim i As Integer
Dim MsgBxTitle As String
Dim NumCharts As Integer
Dim Rtn As VbMsgBoxResult
Dim xlBook As Workbook
Dim xlSheet As Worksheet
MsgBxTitle = "Delete Charts in Worksheet"
'
' set target workbook
'
On Error GoTo xlBookError
If xlBookName = vbNullString Then xlBookName = ActiveWorkbook.Name
Set xlBook = Workbooks(xlBookName)
'
' set target worksheet
'
On Error GoTo xlSheetError
If xlSheetName = vbNullString Then xlSheetName = ActiveSheet.Name
Set xlSheet = xlBook.Worksheets(xlSheetName)
On Error GoTo ErrorHandling
'
' fetch count of charts; if < 1, exit
'
NumCharts = xlSheet.ChartObjects.count
If NumCharts < 1 Then
If InformUser = True Then
MsgBox "There are no embedded chart to delete in worksheet " & _
xlSheetName, vbInformation, MsgBxTitle
End If
Exit Sub
End If
'
' tell user what will happen
'
If InformUser = True Then
Rtn = MsgBox("This procedure will delete all charts" & vbCrLf & _
"embedded in worksheet " & ActiveSheet.Name & vbCrLf & vbCrLf & _
"# charts to be deleted " & NumCharts & vbCrLf & vbCrLf & _
"OK ?", vbQuestion & vbYesNo, MsgBxTitle)
If Rtn <> vbYes Then Exit Sub
End If
'
' delete embedded charts
'
For i = NumCharts To 1 Step -1
xlSheet.ChartObjects(i).Delete
Next i
'
' tell user what happened
'
If InformUser = True Then
MsgBox "xlDelCharts" & vbCrLf & vbCrLf & _
"workbook: " & xlBookName & vbCrLf & _
"worksheet: " & xlSheetName & vbCrLf & _
NumCharts & " chart object(s) successfully deleted", _
vbInformation, MsgBxTitle
End If
Exit Sub
'
' error handling
'
xlBookError:
MsgBox "xlDelCharts: workbook specified is " & xlBookName & vbCrLf & _
"That workbook is not presently open" & vbCrLf & vbCrLf & _
"No actions taken", vbCritical, MsgBxTitle
Exit Sub
xlSheetError:
MsgBox "xlDelCharts: worksheet specified is " & xlSheetName & vbCrLf & _
"That sheet is either not part of " & xlBookName & " or is" & vbCrLf & _
"a chartsheet." & vbCrLf & vbCrLf & _
"No actions taken", vbCritical, MsgBxTitle
Exit Sub
ErrorHandling:
MsgBox "xlDelCharts: error encountered; err = " & str(Err), vbCritical, _
MsgBxTitle
End Sub
Sub xlDelChartsBook( _
Optional xlBookName As String, _
Optional InformUserSheet As Boolean = False, _
Optional InformUserBook As Boolean = True, _
Optional DelWhich As String = "both")
'
'****************************************************************************************
' Function deletes all chart objects in the target workbook
' Passed Values:
' xlBookName [in, string, OPTIONAL] target workbook; default = activeworkbook
' InformUserSheet [in, boolean, OPTIONAL] flag to indicate if user is to be
' informed of progress at sheet level {default = FALSE}
' InformUserBook [in, boolean, OPTIONAL] flag to indicate if user is to be
' informed of progress at book level {default = TRUE}
' DelWhich [in, string, OPTIONAL] indicates what object types will be deleted,
' i.e., embedded charts, chartsheets or both:
' DelWhich = "charts" only embedded charts will be deleted
' DelWhich = "chartsheets" only chartsheets will be deleted
' DelWhich = "both" both types will be deleted
' {default = "both"}
'
'****************************************************************************************
'
Dim MsgBxTitle As String
Dim NumCharts As Integer
Dim NumChSheets As Integer
Dim NumSheets As Integer
Dim Rtn As VbMsgBoxResult
Dim strBuffer As String
Dim xlBook As Workbook
Dim xlChSheet As Chart
Dim xlSheet As Worksheet
MsgBxTitle = "Delete Charts in Workbook"
'
' set target workbook
'
On Error GoTo xlBookError
If xlBookName = vbNullString Then xlBookName = ActiveWorkbook.Name
Set xlBook = Workbooks(xlBookName)
'
' test for valid value of DelWhich
'
Select Case DelWhich
Case "charts", "chartsheets", "both"
Case Else
MsgBox "xlDelChartsBook: DelWhich arguement is invalid" & vbCrLf & vbCrLf & _
"No actions taken", vbCritical, MsgBxTitle
Exit Sub
End Select
On Error GoTo ErrorHandling
If InformUserBook = True Then
'
' collect data to inform user before any charts are deleted
'
NumSheets = xlBook.Worksheets.count
For Each xlSheet In xlBook.Worksheets
strBuffer = strBuffer & " " & xlSheet.Name & " " & _
xlSheet.ChartObjects.count & vbCrLf
NumCharts = NumCharts + xlSheet.ChartObjects.count
Next xlSheet
strBuffer = strBuffer & vbCrLf & "ChartSheets to be deleted:" & vbCrLf
NumChSheets = xlBook.Charts.count
If NumChSheets > 0 Then
For Each xlChSheet In xlBook.Charts
strBuffer = strBuffer & " " & xlChSheet.Name & vbCrLf
Next xlChSheet
strBuffer = strBuffer & vbCrLf & _
"NOTE: Excel would normally warn you about the impending" & vbCrLf & _
"deletion of any chartsheet. Those warnings will be turned" & vbCrLf & _
"off to eliminate the need for you to respond to each prompt" & vbCrLf & _
"and turned back on after deleting the charsheets." & vbCrLf
End If
'
' inform user of what will happen and test for agreement
'
Rtn = MsgBox("This procedure will delete all charts and chartsheets" & vbCrLf & _
"in workbook " & xlBookName & vbCrLf & vbCrLf & _
"Worksheets to be examined and charts in each: " & vbCrLf & strBuffer & _
vbCrLf & "OK ?" & vbCrLf & vbCrLf & _
"[select NO if you want to delete just charts or just charsheets]" & vbCrLf & _
"[select CANCEL if you want to stop the process and exit]", _
vbQuestion & vbYesNoCancel, MsgBxTitle)
Select Case Rtn
Case vbCancel
Exit Sub
Case vbNo
'
' interact with user to clarify "No"
'
DelWhich = _
InputBox("enter 'charts' to delete just charts" & vbCrLf & _
"enter 'chartsheets' to delete just chartsheets" & vbCrLf & _
"enter 'both' to delete both" & vbCrLf & vbCrLf & _
"any other entry or blank or Cancel button will" & vbCrLf & _
"stop the procedure without deleting anything", MsgBxTitle)
DelWhich = LCase(DelWhich)
Select Case DelWhich
Case "charts", "chartsheets", "both"
Case Else
Exit Sub
End Select
Case vbYes
Case Else
Exit Sub
End Select
End If
'
' delete any charts in worksheets
'
If DelWhich = "charts" Or DelWhich = "both" Then
For Each xlSheet In xlBook.Worksheets
Call xlDelCharts(xlBookName, xlSheet.Name, InformUserSheet)
Next xlSheet
End If
'
' delete any chartsheets
'
If DelWhich = "chartsheets" Or DelWhich = "both" Then
Application.DisplayAlerts = False
For Each xlChSheet In xlBook.Charts
xlChSheet.Delete
Next xlChSheet
Application.DisplayAlerts = True
End If
If InformUserBook = True Then
'
' inform user of results
'
If DelWhich = "charts" Then NumChSheets = 0
If DelWhich = "chartsheets" Then
NumSheets = 0
NumCharts = 0
End If
MsgBox "xlDelChartsBook" & vbCrLf & vbCrLf & _
"workbook: " & xlBookName & vbCrLf & _
"# worksheets processed: " & NumSheets & vbCrLf & _
"# charts deleted: " & NumCharts & vbCrLf & _
"# chartsheets deleted: " & NumChSheets, _
vbInformation, MsgBxTitle
End If
Exit Sub
'
' error handling
'
xlBookError:
MsgBox "xlDelChartsBook: workbook specified is " & xlBookName & vbCrLf & _
"That workbook is not presently open" & vbCrLf & vbCrLf & _
"No actions taken", vbCritical, MsgBxTitle
Exit Sub
ErrorHandling:
MsgBox "xlDelChartsBook: error encountered; err = " & str(Err), vbCritical, _
MsgBxTitle
End Sub
------------------------------------------------
Sub Donkey()
Dim R As Range, startCell, firstCell As Range
Dim firstAddress, fAddress As String
Dim FoundCell As Range
Dim i As Long
Dim tradeDt As Double
tradeDt = Application.Worksheets("Home").Range("h21").Value
Set R = Range("EEM_CALLS_quotedate")
Set startCell = R.Cells(1)
Do
Set FoundCell = R.find(what:=tradeDt, _
After:=startCell, _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
fAddress = ActiveCell.Address(False, False)
If FoundCell Is Nothing Then Exit Do
If i = 0 Then
firstAddress = FoundCell.Address
Else
If FoundCell.Address = firstAddress Then Exit Do
End If
i = i + 1
Set startCell = FoundCell
fAddress = ActiveCell.Address
Loop
Range("n25").Value = firstAddress
MsgBox i & " found" & vbCrLf & firstAddress & vbCrLf
End Sub
------------------------------------------------
Sub DontSellPuts()
Range("n12").Select
If ActiveCell.Value = 1 Then
ActiveCell.Value = 0
ElseIf ActiveCell.Value = 0 Then
ActiveCell.Value = 1
End If
End Sub
Sub DontSellCalls()
Range("m12").Select
If ActiveCell.Value = 0 Then
ActiveCell.Value = 1
ElseIf ActiveCell.Value = 1 Then
ActiveCell.Value = 0
End If
End Sub
