var timer:Timer = new Timer(25);
timer.addEventListener(TimerEvent.TIMER, followF);
timer.start();
function followF(e:Event):void{
stage.addEventListener(MouseEvent.MOUSE_MOVE, mouseF);
}
function mouseF(e:MouseEvent):void{
master_mc.glow_mc.x = stage.mouseX - 56;
addEventListener(MouseEvent.MOUSE_MOVE, updateF);
if (mouseX <= 56)
{
master_mc.glow_mc.x = 0;
}
else if (mouseX >= 787.5)
{
master_mc.glow_mc.x = 787.5;
}
function updateF(e:MouseEvent):void{
e.updateAfterEvent();
}
//-----------------------Button Code
master_mc.addEventListener(MouseEvent.MOUSE_DOWN, glowStickF);
function glowStickF(e:MouseEvent):void{
master_mc.glow_mc.x = e.target.x;
}
master_mc.home_btn.addEventListener(MouseEvent.CLICK, homeF);
master_mc.finance_btn.addEventListener(MouseEvent.CLICK, financeF);
master_mc.ec_btn.addEventListener(MouseEvent.CLICK, ecF);
master_mc.technology_btn.addEventListener(MouseEvent.CLICK, techF);
master_mc.business_btn.addEventListener(MouseEvent.CLICK, busF);
master_mc.example_btn.addEventListener(MouseEvent.CLICK, exampleF);
master_mc.programming_btn.addEventListener(MouseEvent.CLICK, blog);
master_mc.articles_btn.addEventListener(MouseEvent.CLICK, articlesF);
function ecF(e:MouseEvent):void
{
var ec:URLRequest = new URLRequest("http://www.quantumsupport.biz/Ethan_Castanon.aspx");
navigateToURL(ec, "_self");
}
function homeF(e:MouseEvent):void
{
var home:URLRequest= new URLRequest("http://www.quantumsupport.biz/index.aspx");
navigateToURL(home, "_self");
}
function articlesF(e:MouseEvent):void
{
var links_and_code:URLRequest=new URLRequest("http://www.quantumsupport.biz/links_and_code.html");
navigateToURL(links_and_code, "_blank");
}
function financeF(e:MouseEvent):void
{
var finance:URLRequest=new URLRequest("http://www.quantumsupport.biz/Financial_Services.aspx");
navigateToURL(finance, "_self");
}
function busF(e:MouseEvent):void
{
var business:URLRequest = new URLRequest("http://www.quantumsupport.biz/Business_Development.aspx");
navigateToURL(business, "_self");
}
function techF(e:MouseEvent):void
{
var technology:URLRequest= new URLRequest("http://www.quantumsupport.biz/Information_Technology.aspx");
navigateToURL(technology, "_self");
}
function exampleF(e:MouseEvent):void
{
var dadsiteexample:URLRequest= new URLRequest("http://www.drcastanon.com");
navigateToURL(dadsiteexample, "_blank");
}
function blog(e:MouseEvent):void
{
var bloglink:URLRequest = new URLRequest("http://quantumsupport.blogspot.com");
navigatetonewURL(bloglink,"_blank");
}
}
Thursday, February 25, 2010
Wednesday, February 24, 2010
Tuesday, February 23, 2010
Properly Using a Sub Procedure in Microsoft Office Excel - Visual Basic for Applications
Option Explicit
Sub callMacros()
MacroInteger 7
MacroString "a String"
MacroIntegerString 4, "some string"
End Sub
Sub MacroInteger(I As Integer)
MsgBox "Integer i=" & I
End Sub
Sub MacroString(S As String)
MsgBox "String value=" & S
End Sub
Sub MacroIntegerString(I As Integer, S As String)
MsgBox "I=" & I & ", S=" & S
End Sub
Sub callMacros()
MacroInteger 7
MacroString "a String"
MacroIntegerString 4, "some string"
End Sub
Sub MacroInteger(I As Integer)
MsgBox "Integer i=" & I
End Sub
Sub MacroString(S As String)
MsgBox "String value=" & S
End Sub
Sub MacroIntegerString(I As Integer, S As String)
MsgBox "I=" & I & ", S=" & S
End Sub
VBA - Loop Downward Sequentially by 13 Rows and Enter a Formula that Changes Sequentially and Format it by Subscripting Some Characters
Sub CycleThrough()
Dim Counter As Integer
Dim Origin As String
Dim BigNum, colNum, BigReduction As Integer
Dim rng As Range
Dim ii As Integer
Dim e, output As String
e = "T"
On Error GoTo what
step = InputBox("What is your vertical step?", DefaultValue, 100, 100)
BigNum = InputBox("How many loops?,How Many Times?", DefaultValue = 100, 100, 100)
BigReduction = BigNum
Set rng = Application.InputBox(prompt:="What is your range?", Type:=8)
If rng Is Nothing Then
MsgBox "Operation Cancelled"
Else
rng.Select
End If
GoTo move
what:
Exit Sub
move:
ii = 0
BigReduction = BigNum
For Counter = 1 To BigReduction
BigNum = BigNum + step
ii = ii + 1
output = e & ii
ActiveCell.Value = output
With ActiveCell.Characters(Start:=2, Length:=2).font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = True
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveCell.Offset(step, 0).Range("a1").Select
If MsgBox("Stop Macro?", vbYesNo) = vbYes Then GoTo what
Next Counter
End Sub
Dim Counter As Integer
Dim Origin As String
Dim BigNum, colNum, BigReduction As Integer
Dim rng As Range
Dim ii As Integer
Dim e, output As String
e = "T"
On Error GoTo what
step = InputBox("What is your vertical step?", DefaultValue, 100, 100)
BigNum = InputBox("How many loops?,How Many Times?", DefaultValue = 100, 100, 100)
BigReduction = BigNum
Set rng = Application.InputBox(prompt:="What is your range?", Type:=8)
If rng Is Nothing Then
MsgBox "Operation Cancelled"
Else
rng.Select
End If
GoTo move
what:
Exit Sub
move:
ii = 0
BigReduction = BigNum
For Counter = 1 To BigReduction
BigNum = BigNum + step
ii = ii + 1
output = e & ii
ActiveCell.Value = output
With ActiveCell.Characters(Start:=2, Length:=2).font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = True
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveCell.Offset(step, 0).Range("a1").Select
If MsgBox("Stop Macro?", vbYesNo) = vbYes Then GoTo what
Next Counter
End Sub
Create a Subscript by Macro
Sub Macro12()
'
' Macro12 Macro
'
'
Range("A204").Select
ActiveCell.FormulaR1C1 = "T14"
With ActiveCell.Characters(Start:=1, Length:=1).font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=2, Length:=2).font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = True
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("D204").Select
End Sub
'
' Macro12 Macro
'
'
Range("A204").Select
ActiveCell.FormulaR1C1 = "T14"
With ActiveCell.Characters(Start:=1, Length:=1).font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=2, Length:=2).font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = True
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("D204").Select
End Sub
Macro - Format Painter - Copy - Jump Downward 13 Rows and Paste Formatting
Sub format_painter()
'
' format_painter Macro
'
'
Selection.Copy
ActiveWindow.SmallScroll Down:=16
ActiveCell.Offset(13, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
'
' format_painter Macro
'
'
Selection.Copy
ActiveWindow.SmallScroll Down:=16
ActiveCell.Offset(13, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Mathematica Link to Microsoft Office Excel for Interconnecting the Two - Extremely Powerful Combination
Mathematica Link for Excel 3.2
Bringing the Power of Mathematica to Excel
With Mathematica Link for Excel, you can have it all: All of
the power and sophistication of Mathematica. All of the
familiarity and convenience of Excel. Mathematica Link for
Excel eliminates the complexities of bridging the two programs,
giving you the best of both worlds.
Mathematica Link for Excel adds over a thousand functions and
options to Excel and lets you interactively explore them using the
Mathematica function wizard. Excel formulas can suddenly perform
symbolic computations, find complex roots, plot equations, and much more.
Displaying Mathematica graphics and typesetting equations in
Excel is as easy
as entering a formula. Data and equations can be visualized in new and
insightful ways that are not possible in Excel alone.
Key Features
Mathematica Link for Excel is a fully bidirectional link
that can be used to:
- Create spreadsheet formulas that call Mathematica from within
Excel - Write code in Mathematica that interacts with and automates
Excel - Call Mathematica code as if it were an Excel macro
- Develop customized Excel import and export routines in
Mathematica - Copy and paste between Mathematica and Excel
- Display Mathematica graphics and typeset expressions in
Excel
Forget about creating cumbersome temporary data files—instead, you
can easily copy and paste data between Mathematica and Excel.
Experience unparalleled "side-by-side" use of both programs as you
programmatically read and write data from Mathematica notebooks
to Excel workbooks, even ones that are currently open in Excel. You
can also convert Mathematica notebooks into Excel macros in
just a few simple steps.
Get the best of both worlds with Mathematica Link for Excel.
About the Developer
productivity, connectivity, and analysis tools for today's extensible
desktop. In addition to commercial software, Episoft provides customized
software solutions and on-site training to a broad range of industries.
Past clients include General Electric, Lucent Technologies, Aerospace
Corporation, Beringer Winery, and the United States Department of Defense.
Episoft was founded in 1997.
Product Support
Mathematica Link for Excel is developed and supported by Episoft, Inc.
Episoft, Inc.
40258 Highway 41, Suite A
Oakhurst, CA 93644
email inquiry@episoft.com
Mathematica Link for Excel 3.2 requires Mathematica 6 or 7
and
Excel 2000 or higher, and is available for Windows 2000/XP/Vista.
Mathematica Link for Excel is © 1998-2009 Episoft, Inc.
| | ||
|
Monday, February 22, 2010
Application Run Method - Powerful & Universal in VBA
To Use the Application.Run Method
You can use the Application.Run method to run Visual Basic Sub procedures or Microsoft Excel version 4.0 macros from other Visual Basic procedures. The Application.Run method requires one named argument: the name of the macro or Sub procedure to be run. (However, other optional arguments may also be included.) This name can be a text string (for example, "TestXLM") or it can be a variable that is equal to the name of the macro.
For example, to run a Microsoft Excel version 4.0 macro called TestXLM, you could use this method:
Application.Run ("TestXLM")
If you have the variable "MacroToRun" set to "TestXLM," you could use this method:
Application.Run (MacroToRun)
Thank you,
Ethan Castanon
Quantum Support – The Union of Finance & Technology
17732 Beach Blvd., Suite D
Huntington Beach, CA 92647
949-945-8665
Email: ethan@quantumsupport.biz
Web: http://www.quantumsupport.biz
You can use the Application.Run method to run Visual Basic Sub procedures or Microsoft Excel version 4.0 macros from other Visual Basic procedures. The Application.Run method requires one named argument: the name of the macro or Sub procedure to be run. (However, other optional arguments may also be included.) This name can be a text string (for example, "TestXLM") or it can be a variable that is equal to the name of the macro.
For example, to run a Microsoft Excel version 4.0 macro called TestXLM, you could use this method:
Application.Run ("TestXLM")
If you have the variable "MacroToRun" set to "TestXLM," you could use this method:
Application.Run (MacroToRun)
Thank you,
Ethan Castanon
Quantum Support – The Union of Finance & Technology
17732 Beach Blvd., Suite D
Huntington Beach, CA 92647
949-945-8665
Email: ethan@quantumsupport.biz
Web: http://www.quantumsupport.biz
Create a New Workbook by Macro
Sub NewBook()
Dim NwBkName As Variant
Dim NewBook As Workbook
Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:="C:\Users\crowbar\Documents\fund work\final\temp.xlsx"
NewBook.Activate
Dim NwBkName As Variant
Dim NewBook As Workbook
Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:="C:\Users\crowbar\Documents\fund work\final\temp.xlsx"
NewBook.Activate
Automate Cut and Paste - In Cases Where Their is a Clear Pattern -
Sub CutNPaste()
ActiveCell.Select
sclng = ActiveCell.Copy
ActiveCell.Offset(1, -1).Select
ActiveCell.PasteSpecial xlPasteAll
ActiveCell.Select
sclng = ActiveCell.Copy
ActiveCell.Offset(1, -1).Select
ActiveCell.PasteSpecial xlPasteAll
Delete Rows Based on Criteria
Sub Find_and_delete()
Dim rng As Range
Dim what As String
Dim strMsg As String
Dim lok4 As String
Dim count As Integer
count = 0
lok4 = Application.InputBox("What variable?")
Do
Set rng = ActiveSheet.UsedRange.Find(lok4)
If rng Is Nothing Then
Exit Do
Else: Rows(rng.Row).Delete
count = (count + 1)
End If
Loop
MsgBox "The number of deleted cells was " & count
End Sub
Thank you,
Ethan Castanon
Quantum Support – The Union of Finance & Technology
17732 Beach Blvd., Suite D
Huntington Beach, CA 92647
949-945-8665
Email: ethan@quantumsupport.biz
Web: http://www.quantumsupport.biz
Dim rng As Range
Dim what As String
Dim strMsg As String
Dim lok4 As String
Dim count As Integer
count = 0
lok4 = Application.InputBox("What variable?")
Do
Set rng = ActiveSheet.UsedRange.Find(lok4)
If rng Is Nothing Then
Exit Do
Else: Rows(rng.Row).Delete
count = (count + 1)
End If
Loop
MsgBox "The number of deleted cells was " & count
End Sub
Thank you,
Ethan Castanon
Quantum Support – The Union of Finance & Technology
17732 Beach Blvd., Suite D
Huntington Beach, CA 92647
949-945-8665
Email: ethan@quantumsupport.biz
Web: http://www.quantumsupport.biz
Excel - Move To a Range Away at a Specified Interval and Automate Cut & Paste Operations
Sub adder()
'
' adder Macro
'
'
Selection.Copy
ActiveCell.Offset(7, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(7, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
End Sub
Thank you,
Ethan Castanon
Quantum Support – The Union of Finance & Technology
17732 Beach Blvd., Suite D
Huntington Beach, CA 92647
949-945-8665
Email: ethan@quantumsupport.biz
Web: http://www.quantumsupport.biz
'
' adder Macro
'
'
Selection.Copy
ActiveCell.Offset(7, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(7, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
End Sub
Thank you,
Ethan Castanon
Quantum Support – The Union of Finance & Technology
17732 Beach Blvd., Suite D
Huntington Beach, CA 92647
949-945-8665
Email: ethan@quantumsupport.biz
Web: http://www.quantumsupport.biz
Excel - VBA - Microsoft Office Excel 2010 - Perform Operations Sequentially Downward at Any Specified Jump Factor and Any Entered Loop Count
Sub CycleThrough()
Dim Counter As Integer
Dim Origin As String
Dim BigNum, colNum, BigReduction As Integer
Dim rng As Range
step = InputBox("What is your vertical step?", DefaultValue, 100, 100)
BigNum = InputBox("How many loops?,How Many Times?", DefaultValue = 100, 100, 100)
BigReduction = BigNum
Set rng = Application.InputBox(prompt:="What is your range?", Type:=8)
If rng Is Nothing Then
MsgBox "Operation Cancelled"
Else
rng.Select
End If
GoTo move
what:
Exit Sub
move:
BigReduction = BigNum
For Counter = 1 To BigReduction
BigNum = BigNum + step
Selection.Copy
ActiveCell.Offset(1 + step, 0).Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
If MsgBox("Stop Macro?", vbYesNo) = vbYes Then GoTo what
Next Counter
End Sub
Thank you,
Ethan Castanon
Quantum Support – The Union of Finance & Technology
17732 Beach Blvd., Suite D
Huntington Beach, CA 92647
949-945-8665
Email: ethan@quantumsupport.biz
Web: http://www.quantumsupport.biz
Dim Counter As Integer
Dim Origin As String
Dim BigNum, colNum, BigReduction As Integer
Dim rng As Range
step = InputBox("What is your vertical step?", DefaultValue, 100, 100)
BigNum = InputBox("How many loops?,How Many Times?", DefaultValue = 100, 100, 100)
BigReduction = BigNum
Set rng = Application.InputBox(prompt:="What is your range?", Type:=8)
If rng Is Nothing Then
MsgBox "Operation Cancelled"
Else
rng.Select
End If
GoTo move
what:
Exit Sub
move:
BigReduction = BigNum
For Counter = 1 To BigReduction
BigNum = BigNum + step
Selection.Copy
ActiveCell.Offset(1 + step, 0).Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
If MsgBox("Stop Macro?", vbYesNo) = vbYes Then GoTo what
Next Counter
End Sub
Thank you,
Ethan Castanon
Quantum Support – The Union of Finance & Technology
17732 Beach Blvd., Suite D
Huntington Beach, CA 92647
949-945-8665
Email: ethan@quantumsupport.biz
Web: http://www.quantumsupport.biz
asp.net - c# - sql
InsertCommand="INSERT INTO [aedha_pts] ([PatientID], [FirstName], [LastName], [DOB], [Issue], [Street], [City], [State], [Zip], [Phone1], [Phone2], [Email], [Insurance], [PaymentForm], [PaymentAmount], [COGS], [EvalDate], [DelivDate], [Warranty], [Notes]) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
ProviderName="<%$ ConnectionStrings:quantbusConnectionString.ProviderName %>"
SelectCommand="SELECT [PatientID], [FirstName], [LastName], [DOB], [Issue], [Street], [City], [State], [Zip], [Phone1], [Phone2], [Email], [Insurance], [PaymentForm], [PaymentAmount], [COGS], [EvalDate], [DelivDate], [Warranty], [Notes] FROM [aedha_pts]"
UpdateCommand="UPDATE [aedha_pts] SET [FirstName] = ?, [LastName] = ?, [DOB] = ?, [Issue] = ?, [Street] = ?, [City] = ?, [State] = ?, [Zip] = ?, [Phone1] = ?, [Phone2] = ?, [Email] = ?, [Insurance] = ?, [PaymentForm] = ?, [PaymentAmount] = ?, [COGS] = ?, [EvalDate] = ?, [DelivDate] = ?, [Warranty] = ?, [Notes] = ? WHERE [PatientID] = ?">
Excel VBA - Functions
Function EndingMktVal(EndW As Single, ETFprcAtExp, CallStk, CallExPrice, CallPriceAtEntry, CallCalled, PutStk, PutCalled, PutExPrice, PutPriceAtEntry)
Dim EndValETF, PutPrem, CallPrem, CallDmg, PutDmg As Currency
Dim RedEndQ As Variant
RedEndQ = ((EndW / 100) * 100)
EndValETF = RedEndQ * ETFprcAtExp
CallPremium = RedEndQ * CallPrc
PutPremium = RedEndQ * PutPrc
CallDmg = ((RedEndQ * (ETFprcAtExp - CallStk)) + CallPremium)
PutDmg = ((RedEndQ * (PutStk - ETFprcAtExp)) + PutPremium)
If (CallCalled = "No" Or CallCalled = "no" And PutCalled = "No" Or PutCalled = "no") Then
EndingMktVal = EndValETF + CallInMoney + PutInMoney
ElseIf (CallCalled = "Yes" Or CallCalled = "yes" And PutCalled = "No" Or PutCalled = "no") Then
EndingMktVal = EndValETF + PutPremium + CallDmg
ElseIf (CallCalled = "No" Or CallCalled = "no" And PutCalled = "Yes" Or PutCalled = "yes") Then
EndingMktVal = EndValETF + CallPremium + PutDmg
ElseIf (CallCalled = "Yes" Or CallCalled = "yes" And PutCalled = "Yes" Or PutCalled = "yes") Then
EndingMktVal = EndValETF + CallDmg + PutDmg
End If
End Function
==================================================================
Function SNorm(z)
Application.ScreenUpdating = False
c1 = 2.506628
c2 = 0.3193815
c3 = -0.3565638
c4 = 1.7814779
c5 = -1.821256
c6 = 1.3302744
If z > 0 Or z = 0 Then
w = 1
Else: w = -1
End If
y = 1 / (1 + 0.2316419 * w * z)
SNorm = 0.5 + w * (0.5 - (Exp(-z * z / 2) / c1) * _
(y * (c2 + y * (c3 + y * (c4 + y * (c5 + y * c6))))))
Application.ScreenUpdating = True
End Function
'**********************************************************************
'* Black-Scholes European Call Price Computation *
'**********************************************************************
Function Call_Eur(s, x, t, r, sd)
Application.ScreenUpdating = False
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / x)
b = (r + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Call_Eur = s * SNorm(d1) - x * Exp(-r * t) * SNorm(d2)
Application.ScreenUpdating = True
End Function
'*********************************************************************
'* Black-Scholes European Put Price Computation *
'*********************************************************************
Function Put_Eur(s, x, t, r, sd)
Application.ScreenUpdating = False
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / x)
b = (r + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
CallEur = s * SNorm(d1) - x * Exp(-r * t) * SNorm(d2)
Put_Eur = x * Exp(-r * t) - s + CallEur
Application.ScreenUpdating = True
End Function
Equals (=)
Less than (<) Less than or equal to (<=) Greater than (>)
Greater than or equal to (>=)
Not equal to (<>)
Dim EndValETF, PutPrem, CallPrem, CallDmg, PutDmg As Currency
Dim RedEndQ As Variant
RedEndQ = ((EndW / 100) * 100)
EndValETF = RedEndQ * ETFprcAtExp
CallPremium = RedEndQ * CallPrc
PutPremium = RedEndQ * PutPrc
CallDmg = ((RedEndQ * (ETFprcAtExp - CallStk)) + CallPremium)
PutDmg = ((RedEndQ * (PutStk - ETFprcAtExp)) + PutPremium)
If (CallCalled = "No" Or CallCalled = "no" And PutCalled = "No" Or PutCalled = "no") Then
EndingMktVal = EndValETF + CallInMoney + PutInMoney
ElseIf (CallCalled = "Yes" Or CallCalled = "yes" And PutCalled = "No" Or PutCalled = "no") Then
EndingMktVal = EndValETF + PutPremium + CallDmg
ElseIf (CallCalled = "No" Or CallCalled = "no" And PutCalled = "Yes" Or PutCalled = "yes") Then
EndingMktVal = EndValETF + CallPremium + PutDmg
ElseIf (CallCalled = "Yes" Or CallCalled = "yes" And PutCalled = "Yes" Or PutCalled = "yes") Then
EndingMktVal = EndValETF + CallDmg + PutDmg
End If
End Function
==================================================================
Function SNorm(z)
Application.ScreenUpdating = False
c1 = 2.506628
c2 = 0.3193815
c3 = -0.3565638
c4 = 1.7814779
c5 = -1.821256
c6 = 1.3302744
If z > 0 Or z = 0 Then
w = 1
Else: w = -1
End If
y = 1 / (1 + 0.2316419 * w * z)
SNorm = 0.5 + w * (0.5 - (Exp(-z * z / 2) / c1) * _
(y * (c2 + y * (c3 + y * (c4 + y * (c5 + y * c6))))))
Application.ScreenUpdating = True
End Function
'**********************************************************************
'* Black-Scholes European Call Price Computation *
'**********************************************************************
Function Call_Eur(s, x, t, r, sd)
Application.ScreenUpdating = False
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / x)
b = (r + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
Call_Eur = s * SNorm(d1) - x * Exp(-r * t) * SNorm(d2)
Application.ScreenUpdating = True
End Function
'*********************************************************************
'* Black-Scholes European Put Price Computation *
'*********************************************************************
Function Put_Eur(s, x, t, r, sd)
Application.ScreenUpdating = False
Dim a As Single
Dim b As Single
Dim c As Single
Dim d1 As Single
Dim d2 As Single
a = Log(s / x)
b = (r + 0.5 * sd ^ 2) * t
c = sd * (t ^ 0.5)
d1 = (a + b) / c
d2 = d1 - sd * (t ^ 0.5)
CallEur = s * SNorm(d1) - x * Exp(-r * t) * SNorm(d2)
Put_Eur = x * Exp(-r * t) - s + CallEur
Application.ScreenUpdating = True
End Function
Equals (=)
Less than (<) Less than or equal to (<=) Greater than (>)
Greater than or equal to (>=)
Not equal to (<>)
Excel - VBA - Named Ranges
Working With Names In Visual Basic
You can use VBA code to work with defined names. To add a name, use
ThisWorkbook.Names.Add Name:="SomeName", _
RefersTo:=Worksheets("Sheet2").Range("A1:A10")
This will assign the Name SomeName to the range A1:A10 on Sheet2. If you add a Name that already exists, the Name is automatically deleted and recreated with the new reference. It is not necessary to delete the Name before recreating it.
By default, names created manually or with VBA code are visible -- they will appear in the Name Box drop down and in the Names dialog. You can, however, make the name hidden so that it isn't visible to the user. A hidden Name can be used in any manner just like a normal, visible Name. To make a name hidden, you set the Visible parameter to False. For example,
ThisWorkbook.Names.Add Name:="SomeName2", _
RefersTo:=Worksheets("Sheet2").Range("B1:B10"), _
Visible:=False
The name SomeName2 can be used exactly as a visible name, but will not appear to the user. The only way to hide a Defined Name is via VBA code. There is nothing in the Excel user interface that allows you to hide a Name.
To delete a name using VBA code, use code like the following:
ThisWorkbook.Names("TheName").Delete
Using Defined Names in VBA code is different than using them in worksheet cells. You must get the value of the Name using the RefersTo or RefersToRange properties. If a Name doesn't refer to a cell or range of cells (e.g., it refers to a constant), an attempt to use RefersToRange will fail. To get the value of a Name that contains a constant, use the RefersTo property.
V = ThisWorkbook.Names("TheName").RefersToRange
If the name refers to a range of 2 or more cells, you can assign it to a Range type variable. For example,
Dim R As Range
Set R = ThisWorkbook.Names("BigName").RefersToRange
Debug.Print R.Address
If the name refers to a constant, you'll need to strip out some characters to get the actual value. For example, if the name MyName refers to the text constant Chip Pearson, the RefersTo property will return the text ="Chip Pearson". You need to strip out the leading equals sign and the enclosing quotes. You can do this with code like the following:
Dim S As String
S = ThisWorkbook.Names("MyName").RefersTo
S = Mid(S, 3, Len(S) - 3)
Debug.Print S
If the name refers to a numeric constant, there will be a leading equal sign but no quotes. Thus, you'll need to strip off the leading equals sign. The code below illustrates this.
Dim S As String
S = ThisWorkbook.Names("MaxPages").RefersTo
S = Mid(S, 2)
Debug.Print S
We can put all this together into a function that will return what the given name refers to, be it a range, text constant, or numeric constant.
Function GetNameRefersTo(TheName As String) As String
Dim S As String
Dim HasRef As Boolean
Dim R As Range
Dim NM As Name
Set NM = ThisWorkbook.Names(TheName)
On Error Resume Next
Set R = NM.RefersToRange
If Err.Number = 0 Then
HasRef = True
Else
HasRef = False
End If
If HasRef = True Then
S = R.Text
Else
S = NM.RefersTo
If StrComp(Mid(S, 2, 1), Chr(34), vbBinaryCompare) = 0 Then
' text constant
S = Mid(S, 3, Len(S) - 3)
Else
' numeric contant
S = Mid(S, 2)
End If
End If
GetNameRefersTo = S
End Function
Macros, Macros, Macros - Excel - Visual Basic for Applications Programming
Automation is the future -
Below you will find VBA macros to be used in Microsoft Office Excel with their associated descriptions -
----------------------------------------------------------------------------------------------------------
Load up an Excel UserForm with Drop Down Combo Boxes
=================================================================
Private Sub CommandButtonSubmit_Click()
Dim port As Currency
Dim bg_dbc_st, bg_eem_st, bg_efa_st, bg_iwm_st, bg_iyr_st, bg_mdy_st, bg_spy_st As Currency
Dim md_dbc_st, md_eem_st, md_efa_st, md_iwm_st, md_iyr_st, md_mdy_st, md_spy_st As Currency
Dim nd_dbc_st, nd_eem_st, nd_efa_st, nd_iwm_st, nd_iyr_st, nd_mdy_st, nd_spy_st As Currency
Dim beginNum, endNum, thirteen_add, loop_counter As Integer
Dim dbc_st, eem_st, efa_st, iwm_st, iyr_st, mdy_st, spy_st As Single
Application.ScreenUpdating = False
Worksheets("Home").Range("bz2").Select
loop_counter = ActiveCell.Value
ActiveCell.Value = (ActiveCell.Value + 1)
If start_int_cmbo.Value = "T1" Then
beginNum = 1
ElseIf start_int_cmbo.Value = "T2" Then
beginNum = 2
ElseIf start_int_cmbo.Value = "T3" Then
beginNum = 3
ElseIf start_int_cmbo.Value = "T4" Then
beginNum = 4
ElseIf start_int_cmbo.Value = "T5" Then
beginNum = 5
ElseIf start_int_cmbo.Value = "T6" Then
beginNum = 6
ElseIf start_int_cmbo.Value = "T7" Then
beginNum = 7
ElseIf start_int_cmbo.Value = "T8" Then
beginNum = 8
ElseIf start_int_cmbo.Value = "T9" Then
beginNum = 9
ElseIf start_int_cmbo.Value = "T10" Then
beginNum = 10
ElseIf start_int_cmbo.Value = "T11" Then
beginNum = 11
ElseIf start_int_cmbo.Value = "T12" Then
beginNum = 12
ElseIf start_int_cmbo.Value = "T13" Then
beginNum = 13
ElseIf start_int_cmbo.Value = "T14" Then
beginNum = 14
ElseIf start_int_cmbo.Value = "T15" Then
beginNum = 15
ElseIf start_int_cmbo.Value = "T16" Then
beginNum = 16
ElseIf start_int_cmbo.Value = "T17" Then
beginNum = 17
ElseIf start_int_cmbo.Value = "T18" Then
beginNum = 18
ElseIf start_int_cmbo.Value = "T19" Then
beginNum = 19
ElseIf start_int_cmbo.Value = "T20" Then
beginNum = 20
ElseIf start_int_cmbo.Value = "T21" Then
beginNum = 21
ElseIf start_int_cmbo.Value = "T22" Then
beginNum = 22
ElseIf start_int_cmbo.Value = "T23" Then
beginNum = 23
ElseIf start_int_cmbo.Value = "T24" Then
beginNum = 24
ElseIf start_int_cmbo.Value = "T25" Then
beginNum = 25
ElseIf start_int_cmbo.Value = "T26" Then
beginNum = 26
ElseIf start_int_cmbo.Value = "T27" Then
beginNum = 27
ElseIf start_int_cmbo.Value = "T28" Then
beginNum = 28
ElseIf start_int_cmbo.Value = "T29" Then
beginNum = 29
ElseIf start_int_cmbo.Value = "T30" Then
beginNum = 30
ElseIf start_int_cmbo.Value = "T31" Then
beginNum = 31
ElseIf start_int_cmbo.Value = "T32" Then
beginNum = 32
ElseIf start_int_cmbo.Value = "T33" Then
beginNum = 33
ElseIf start_int_cmbo.Value = "T34" Then
beginNum = 34
ElseIf start_int_cmbo.Value = "T35" Then
beginNum = 35
ElseIf start_int_cmbo.Value = "T36" Then
beginNum = 36
End If
If end_int_cmbo.Value = "T1" Then
endNum = 1
ElseIf end_int_cmbo.Value = "T2" Then
endNum = 2
ElseIf end_int_cmbo.Value = "T3" Then
endNum = 3
ElseIf end_int_cmbo.Value = "T4" Then
endNum = 4
ElseIf end_int_cmbo.Value = "T5" Then
endNum = 5
ElseIf end_int_cmbo.Value = "T6" Then
endNum = 6
ElseIf end_int_cmbo.Value = "T7" Then
endNum = 7
ElseIf end_int_cmbo.Value = "T8" Then
endNum = 8
ElseIf end_int_cmbo.Value = "T9" Then
endNum = 9
ElseIf end_int_cmbo.Value = "T10" Then
endNum = 10
ElseIf end_int_cmbo.Value = "T11" Then
endNum = 11
ElseIf end_int_cmbo.Value = "T12" Then
endNum = 12
ElseIf end_int_cmbo.Value = "T13" Then
endNum = 13
ElseIf end_int_cmbo.Value = "T14" Then
endNum = 14
ElseIf end_int_cmbo.Value = "T15" Then
endNum = 15
ElseIf end_int_cmbo.Value = "T16" Then
endNum = 16
ElseIf end_int_cmbo.Value = "T17" Then
endNum = 17
ElseIf end_int_cmbo.Value = "T18" Then
endNum = 18
ElseIf end_int_cmbo.Value = "T19" Then
endNum = 19
ElseIf end_int_cmbo.Value = "T20" Then
endNum = 20
ElseIf end_int_cmbo.Value = "T21" Then
endNum = 21
ElseIf end_int_cmbo.Value = "T22" Then
endNum = 22
ElseIf end_int_cmbo.Value = "T23" Then
endNum = 23
ElseIf end_int_cmbo.Value = "T24" Then
endNum = 24
ElseIf end_int_cmbo.Value = "T25" Then
endNum = 25
ElseIf end_int_cmbo.Value = "T26" Then
endNum = 26
ElseIf end_int_cmbo.Value = "T27" Then
endNum = 27
ElseIf end_int_cmbo.Value = "T28" Then
endNum = 28
ElseIf end_int_cmbo.Value = "T29" Then
endNum = 29
ElseIf end_int_cmbo.Value = "T30" Then
endNum = 30
ElseIf end_int_cmbo.Value = "T31" Then
endNum = 31
ElseIf end_int_cmbo.Value = "T32" Then
endNum = 32
ElseIf end_int_cmbo.Value = "T33" Then
endNum = 33
ElseIf end_int_cmbo.Value = "T34" Then
endNum = 34
ElseIf end_int_cmbo.Value = "T35" Then
endNum = 35
ElseIf end_int_cmbo.Value = "T36" Then
endNum = 36
End If
On Error GoTo Blanks
bg_dbc_st = (DBC_interval_w8_start.Value / 100)
bg_eem_st = (EEM_interval_w8_start.Value / 100)
bg_efa_st = (EFA_interval_w8_start.Value / 100)
bg_iwm_st = (IWM_interval_w8_start.Value / 100)
bg_iyr_st = (IYR_interval_w8_start.Value / 100)
bg_mdy_st = (MDY_interval_w8_start.Value / 100)
bg_spy_st = (SPY_interval_w8_start.Value / 100)
Blanks:
MsgBox "Blanks values aren't acceptable. Please make entries: zero is ok for blanks."
Exit Sub
If (100 * (bg_dbc_st + bg_eem_st + bg_efa_st + bg_iwm_st + bg_iyr_st + bg_mdy_st + bg_spy_st) <> 100) Then GoTo Pass
Worksheets("Home").Range("bz2").Select
loop_counter = ActiveCell.Value
ActiveCell.Value = loop_counter + 1
Worksheets("Home").Cells(3, loop_counter + 79).Value = (bg_dbc_st * 100)
Worksheets("Home").Cells(4, loop_counter + 79).Value = (bg_eem_st * 100)
Worksheets("Home").Cells(5, loop_counter + 79).Value = (bg_efa_st * 100)
Worksheets("Home").Cells(6, loop_counter + 79).Value = (bg_iwm_st * 100)
Worksheets("Home").Cells(7, loop_counter + 79).Value = (bg_iyr_st * 100)
Worksheets("Home").Cells(8, loop_counter + 79).Value = (bg_mdy_st * 100)
Worksheets("Home").Cells(9, loop_counter + 79).Value = (bg_spy_st * 100)
thirteen_add = 5
For a_counter = beginNum To endNum
thirteen_add = (thirteen_add + 13)
begin_c_val = (thirteen_add + 5)
Sheets("Home").Cells(begin_c_val, 5).Select
ActiveCell.Value = bg_dbc_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 1, 5).Select
ActiveCell.Value = bg_eem_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 2, 5).Select
ActiveCell.Value = bg_efa_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 3, 5).Select
ActiveCell.Value = bg_iwm_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 4, 5).Select
ActiveCell.Value = bg_iyr_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 5, 5).Select
ActiveCell.Value = bg_mdy_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 6, 5).Select
ActiveCell.Value = bg_spy_st * Sheets("Home").Cells(thirteen_add, 22)
Next a_counter
Pass:
MsgBox "The weights do not add up to 100%. Please make the necessary corrections, and resubmit."
Exit Sub
Sheets("Home").Cells(1, 1).Select
Application.ScreenUpdating = True
MsgBox "start_int_cmbo box value is " & start_int_cmbo.Value & vbCrLf & "start number equals " & beginNum & vbCrLf & "end number equals " & endNum & vbCrLf & "bg_dbc_st value is " & bg_dbc_st & vbCrLf & "Loop Counting Value is: " & loop_counter & vbCrLf & vbInformation
End Sub
Below you will find VBA macros to be used in Microsoft Office Excel with their associated descriptions -
----------------------------------------------------------------------------------------------------------
Load up an Excel UserForm with Drop Down Combo Boxes
=================================================================
Private Sub CommandButtonSubmit_Click()
Dim port As Currency
Dim bg_dbc_st, bg_eem_st, bg_efa_st, bg_iwm_st, bg_iyr_st, bg_mdy_st, bg_spy_st As Currency
Dim md_dbc_st, md_eem_st, md_efa_st, md_iwm_st, md_iyr_st, md_mdy_st, md_spy_st As Currency
Dim nd_dbc_st, nd_eem_st, nd_efa_st, nd_iwm_st, nd_iyr_st, nd_mdy_st, nd_spy_st As Currency
Dim beginNum, endNum, thirteen_add, loop_counter As Integer
Dim dbc_st, eem_st, efa_st, iwm_st, iyr_st, mdy_st, spy_st As Single
Application.ScreenUpdating = False
Worksheets("Home").Range("bz2").Select
loop_counter = ActiveCell.Value
ActiveCell.Value = (ActiveCell.Value + 1)
If start_int_cmbo.Value = "T1" Then
beginNum = 1
ElseIf start_int_cmbo.Value = "T2" Then
beginNum = 2
ElseIf start_int_cmbo.Value = "T3" Then
beginNum = 3
ElseIf start_int_cmbo.Value = "T4" Then
beginNum = 4
ElseIf start_int_cmbo.Value = "T5" Then
beginNum = 5
ElseIf start_int_cmbo.Value = "T6" Then
beginNum = 6
ElseIf start_int_cmbo.Value = "T7" Then
beginNum = 7
ElseIf start_int_cmbo.Value = "T8" Then
beginNum = 8
ElseIf start_int_cmbo.Value = "T9" Then
beginNum = 9
ElseIf start_int_cmbo.Value = "T10" Then
beginNum = 10
ElseIf start_int_cmbo.Value = "T11" Then
beginNum = 11
ElseIf start_int_cmbo.Value = "T12" Then
beginNum = 12
ElseIf start_int_cmbo.Value = "T13" Then
beginNum = 13
ElseIf start_int_cmbo.Value = "T14" Then
beginNum = 14
ElseIf start_int_cmbo.Value = "T15" Then
beginNum = 15
ElseIf start_int_cmbo.Value = "T16" Then
beginNum = 16
ElseIf start_int_cmbo.Value = "T17" Then
beginNum = 17
ElseIf start_int_cmbo.Value = "T18" Then
beginNum = 18
ElseIf start_int_cmbo.Value = "T19" Then
beginNum = 19
ElseIf start_int_cmbo.Value = "T20" Then
beginNum = 20
ElseIf start_int_cmbo.Value = "T21" Then
beginNum = 21
ElseIf start_int_cmbo.Value = "T22" Then
beginNum = 22
ElseIf start_int_cmbo.Value = "T23" Then
beginNum = 23
ElseIf start_int_cmbo.Value = "T24" Then
beginNum = 24
ElseIf start_int_cmbo.Value = "T25" Then
beginNum = 25
ElseIf start_int_cmbo.Value = "T26" Then
beginNum = 26
ElseIf start_int_cmbo.Value = "T27" Then
beginNum = 27
ElseIf start_int_cmbo.Value = "T28" Then
beginNum = 28
ElseIf start_int_cmbo.Value = "T29" Then
beginNum = 29
ElseIf start_int_cmbo.Value = "T30" Then
beginNum = 30
ElseIf start_int_cmbo.Value = "T31" Then
beginNum = 31
ElseIf start_int_cmbo.Value = "T32" Then
beginNum = 32
ElseIf start_int_cmbo.Value = "T33" Then
beginNum = 33
ElseIf start_int_cmbo.Value = "T34" Then
beginNum = 34
ElseIf start_int_cmbo.Value = "T35" Then
beginNum = 35
ElseIf start_int_cmbo.Value = "T36" Then
beginNum = 36
End If
If end_int_cmbo.Value = "T1" Then
endNum = 1
ElseIf end_int_cmbo.Value = "T2" Then
endNum = 2
ElseIf end_int_cmbo.Value = "T3" Then
endNum = 3
ElseIf end_int_cmbo.Value = "T4" Then
endNum = 4
ElseIf end_int_cmbo.Value = "T5" Then
endNum = 5
ElseIf end_int_cmbo.Value = "T6" Then
endNum = 6
ElseIf end_int_cmbo.Value = "T7" Then
endNum = 7
ElseIf end_int_cmbo.Value = "T8" Then
endNum = 8
ElseIf end_int_cmbo.Value = "T9" Then
endNum = 9
ElseIf end_int_cmbo.Value = "T10" Then
endNum = 10
ElseIf end_int_cmbo.Value = "T11" Then
endNum = 11
ElseIf end_int_cmbo.Value = "T12" Then
endNum = 12
ElseIf end_int_cmbo.Value = "T13" Then
endNum = 13
ElseIf end_int_cmbo.Value = "T14" Then
endNum = 14
ElseIf end_int_cmbo.Value = "T15" Then
endNum = 15
ElseIf end_int_cmbo.Value = "T16" Then
endNum = 16
ElseIf end_int_cmbo.Value = "T17" Then
endNum = 17
ElseIf end_int_cmbo.Value = "T18" Then
endNum = 18
ElseIf end_int_cmbo.Value = "T19" Then
endNum = 19
ElseIf end_int_cmbo.Value = "T20" Then
endNum = 20
ElseIf end_int_cmbo.Value = "T21" Then
endNum = 21
ElseIf end_int_cmbo.Value = "T22" Then
endNum = 22
ElseIf end_int_cmbo.Value = "T23" Then
endNum = 23
ElseIf end_int_cmbo.Value = "T24" Then
endNum = 24
ElseIf end_int_cmbo.Value = "T25" Then
endNum = 25
ElseIf end_int_cmbo.Value = "T26" Then
endNum = 26
ElseIf end_int_cmbo.Value = "T27" Then
endNum = 27
ElseIf end_int_cmbo.Value = "T28" Then
endNum = 28
ElseIf end_int_cmbo.Value = "T29" Then
endNum = 29
ElseIf end_int_cmbo.Value = "T30" Then
endNum = 30
ElseIf end_int_cmbo.Value = "T31" Then
endNum = 31
ElseIf end_int_cmbo.Value = "T32" Then
endNum = 32
ElseIf end_int_cmbo.Value = "T33" Then
endNum = 33
ElseIf end_int_cmbo.Value = "T34" Then
endNum = 34
ElseIf end_int_cmbo.Value = "T35" Then
endNum = 35
ElseIf end_int_cmbo.Value = "T36" Then
endNum = 36
End If
On Error GoTo Blanks
bg_dbc_st = (DBC_interval_w8_start.Value / 100)
bg_eem_st = (EEM_interval_w8_start.Value / 100)
bg_efa_st = (EFA_interval_w8_start.Value / 100)
bg_iwm_st = (IWM_interval_w8_start.Value / 100)
bg_iyr_st = (IYR_interval_w8_start.Value / 100)
bg_mdy_st = (MDY_interval_w8_start.Value / 100)
bg_spy_st = (SPY_interval_w8_start.Value / 100)
Blanks:
MsgBox "Blanks values aren't acceptable. Please make entries: zero is ok for blanks."
Exit Sub
If (100 * (bg_dbc_st + bg_eem_st + bg_efa_st + bg_iwm_st + bg_iyr_st + bg_mdy_st + bg_spy_st) <> 100) Then GoTo Pass
Worksheets("Home").Range("bz2").Select
loop_counter = ActiveCell.Value
ActiveCell.Value = loop_counter + 1
Worksheets("Home").Cells(3, loop_counter + 79).Value = (bg_dbc_st * 100)
Worksheets("Home").Cells(4, loop_counter + 79).Value = (bg_eem_st * 100)
Worksheets("Home").Cells(5, loop_counter + 79).Value = (bg_efa_st * 100)
Worksheets("Home").Cells(6, loop_counter + 79).Value = (bg_iwm_st * 100)
Worksheets("Home").Cells(7, loop_counter + 79).Value = (bg_iyr_st * 100)
Worksheets("Home").Cells(8, loop_counter + 79).Value = (bg_mdy_st * 100)
Worksheets("Home").Cells(9, loop_counter + 79).Value = (bg_spy_st * 100)
thirteen_add = 5
For a_counter = beginNum To endNum
thirteen_add = (thirteen_add + 13)
begin_c_val = (thirteen_add + 5)
Sheets("Home").Cells(begin_c_val, 5).Select
ActiveCell.Value = bg_dbc_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 1, 5).Select
ActiveCell.Value = bg_eem_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 2, 5).Select
ActiveCell.Value = bg_efa_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 3, 5).Select
ActiveCell.Value = bg_iwm_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 4, 5).Select
ActiveCell.Value = bg_iyr_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 5, 5).Select
ActiveCell.Value = bg_mdy_st * Sheets("Home").Cells(thirteen_add, 22)
Sheets("Home").Cells(begin_c_val + 6, 5).Select
ActiveCell.Value = bg_spy_st * Sheets("Home").Cells(thirteen_add, 22)
Next a_counter
Pass:
MsgBox "The weights do not add up to 100%. Please make the necessary corrections, and resubmit."
Exit Sub
Sheets("Home").Cells(1, 1).Select
Application.ScreenUpdating = True
MsgBox "start_int_cmbo box value is " & start_int_cmbo.Value & vbCrLf & "start number equals " & beginNum & vbCrLf & "end number equals " & endNum & vbCrLf & "bg_dbc_st value is " & bg_dbc_st & vbCrLf & "Loop Counting Value is: " & loop_counter & vbCrLf & vbInformation
End Sub
Subscribe to:
Posts (Atom)