Dim intm As Double
intm = beginW - Application.WorksheetFunction.RoundDown(beginW, 0)
plit = intm
End Function
Sub Macro1()
'
' Macro1 Macro
'
'
ActiveSheet.ChartObjects("Chart 4").Activate
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
End Sub
Sub Print_Chart_and_Assoc_Table()
'
' Print_Chart_and_Assoc_Table Macro
'
'
ActiveSheet.ChartObjects("Chart 1").Activate
Range("P1228:AZ1235").Select
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Select
Range("P1228:AZ1235,P1228").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Select
Range("P1228").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlDown)).Select
Range("P1228:P1235").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "Returns Broken Down by Allocation"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = True
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 12
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "Returns Broken Down by Allocation"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = True
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.000%"
Columns("AT:AT").ColumnWidth = 10.86
Columns("AT:AT").ColumnWidth = 9.43
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "Returns Broken Down by Allocation"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = True
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 40
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 2
Range("B1").Select
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 28
Application.GoTo Reference:="chart_the_region"
ActiveWindow.SmallScroll Down:=120
ActiveWindow.LargeScroll Down:=1
Range("L837").Select
ActiveWindow.LargeScroll Down:=1
Range("L869").Select
ActiveWindow.LargeScroll Down:=1
Range("L901").Select
ActiveWindow.LargeScroll Down:=1
Range("L933").Select
ActiveWindow.LargeScroll Down:=1
Range("L965").Select
ActiveWindow.LargeScroll Down:=1
Range("L997").Select
ActiveWindow.LargeScroll Down:=1
Range("L1029").Select
ActiveWindow.LargeScroll Down:=1
Range("L1061").Select
ActiveWindow.LargeScroll Down:=1
Range("AK1120").Select
ActiveWindow.LargeScroll Down:=1
Range("AK1152").Select
ActiveWindow.LargeScroll Down:=1
Range("AK1184").Select
ActiveWindow.LargeScroll Down:=1
Range("AK1216").Select
ActiveWindow.LargeScroll Down:=1
Range("AK1248").Select
ActiveWindow.LargeScroll Down:=1
Range("AK1280").Select
ActiveWindow.LargeScroll Down:=-1
Range("AK1248").Select
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
Range("P1228:AZ1246").Select
Range("P1228:AZ1246").Cut Destination:=Range("AX1230:CH1248")
Range("AX1230:CH1248").Select
ActiveWindow.ScrollColumn = 68
ActiveWindow.ScrollColumn = 67
ActiveWindow.ScrollColumn = 66
ActiveWindow.ScrollColumn = 65
ActiveWindow.ScrollColumn = 64
ActiveWindow.ScrollColumn = 62
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 45
Columns("AX:AX").ColumnWidth = 9.57
Columns("AX:CH").Select
Range("AX1221").Activate
Selection.ColumnWidth = 5.14
Selection.ColumnWidth = 7.57
Selection.ColumnWidth = 8
ActiveWindow.ScrollColumn = 68
ActiveWindow.ScrollColumn = 67
ActiveWindow.ScrollColumn = 66
ActiveWindow.ScrollColumn = 64
ActiveWindow.ScrollColumn = 62
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 43
Range("AV1235").Select
ChDir "C:\Users\crowbar\Documents\fund work\final"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\crowbar\Documents\fund work\final\ETF - Simulation - o.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=True
Range("AV1229").Select
Sheets("Home").Select
End Sub
--------------------------------------
Sub Macro6()
'
' Macro6 Macro
'
'
Selection.Copy
ActiveCell.Offset(13, 0).Range("A1:D7").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=32
Selection.Copy
ActiveCell.Offset(13, 0).Range("A1:D7").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
--------------------------------------
Sub Test()
Dim Names As Range, ResultDestination As Range, FirstBlank As Range
Dim c As Range, Hit As Boolean, i As Long, j As Long
Dim Deps(), Arrs()
Set ResultDestination = Range("AE17")
Set FirstBlank = Range("AB17:AC" & Rows.count).SpecialCells(xlCellTypeBlanks).Range("A1")
Set Names = Intersect(FirstBlank.EntireRow, Range("Z:Z"))
Set Names = Range(Names, Names.End(xlDown))
ReDim Deps(1 To Application.WorksheetFunction.count(Names.Offset(, 2)))
ReDim Arrs(1 To Application.WorksheetFunction.count(Names.Offset(, 3)))
For Each c In Names
If c.Offset(, 2) <> "" Then
i = i + 1
Deps(i) = c.Row
End If
If c.Offset(, 3) <> "" Then
j = j + 1
Arrs(j) = c.Row
End If
Next
ResultDestination.Resize(UBound(Deps), 4).ClearContents
For i = 1 To UBound(Deps)
Hit = False
For j = 1 To UBound(Arrs)
If Range("Z" & Deps(i)) & Range("AA" & Deps(i)) = Range("Z" & Arrs(j)) & Range("AA" & Arrs(j)) Then
Hit = True
Exit For
End If
Next
If Hit Then
With ResultDestination.Resize(UBound(Deps)).SpecialCells(xlCellTypeBlanks).Range("A1")
.Value = Range("Z" & Deps(i))
.Offset(, 1) = Range("AA" & Deps(i))
.Offset(, 2) = Range("AB" & Deps(i))
.Offset(, 3) = Range("AC" & Arrs(j))
End With
End If
Next
End Sub
--------------------------------------
Sub GetSetVarVals()
For Each myVar In ActiveDocument.Variables
If myVar.Name = "VarVal" Then
ActiveDocument.Variables("VarVal").Delete
End If
Next myVar
ActiveDocument.Variables.Add Name:="VarVal", _
Value:=ActiveDocument.Variables("FullName").Value
' Retrieve the contents of the document variable.
MsgBox "Second method" & _
vbCr & ActiveDocument.Variables("VarVal").Value
End Sub
Sub DelVariables() 'Delete the variable "FullName".
For Each myVar In ActiveDocument.Variables
If myVar.Name = "FullName" Then
ActiveDocument.Variables("FullName").Delete
End If
Next myVar
End Sub
--------------------------------------
Sub Penetrator()
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
--------------------------------------
Sub Penetrator()
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
--------------------------------------
Function penetCeem(striker As Single, underlying As Single)
Dim strik, under, cor As Single
Dim prod, diff As Single
Dim zer As Integer
zer = 0
strik = striker
under = underlying
cor = (0.2478)
diff = under - strik
prod = cor * under
If under < strik Then
penetCeem = diff
ElseIf under > strik And diff < 0 And prod > 0 And prod < 0 Then
penetCeem = (prod)
Else
penetCeem = 0
End If
End Function
Function penetPeem(striker As Single, underlying As Single)
Dim strik, under, cor As Single
Dim prod, diff As Single
Dim zer As Integer
zer = 0
strik = striker
under = underlying
cor = (0.2478)
diff = under - strik
prod = cor * under
If under < strik Then
penetPeem = diff
ElseIf under > strik And diff < 0 And prod > 0 And prod < 0 Then
penetPeem = (prod)
Else
penetPeem = 0
End If
End Function
--------------------------------------
Function penetC(striker As Single, underlying As Single)
Dim strik, under, cor, ee, dd As Single
Dim prod, diff As Single
Dim zer As Integer
On Error GoTo Nex
zer = 0
strik = striker
under = underlying
cor = (0.218169)
diff = underlying - striker
prod = cor * under
dd = cor * underlying
ee = diff * 0.9
ff = diff * 0.8
gg = diff * 0.7
If underlying > striker And diff > 0 And prod > 0 And diff > (ee) Then
penetC = ee
ElseIf underlying > striker And diff > 0 And prod > 0 And diff > (ff) Then
penetC = ff
ElseIf underlying > striker And diff > 0 And prod > 0 And diff > (gg) Then
penetC = gg
ElseIf underlying > striker And diff > 0 And prod > 0 Then
penetC = diff * (1 - cor) * (0.9)
ElseIf under < strik And diff > 0 And prod > 0 Then
penetC = cor * under
ElseIf Application.WorksheetFunction.Max(prod, diff) < zer Then
penetC = 0
End If
Nex:
End Function
Function penetP(striker As Single, underlying As Single)
Dim strik, under, cor, ee, dd, ff, gg, hh, ii As Single
Dim prod, diff As Single
Dim zer As Integer
On Error GoTo Nex
zer = 0
strik = striker
under = underlying
cor = -1 * (0.218169)
diff = striker - underlying
prod = (cor) * under
dd = 0.9 * underlying
ee = diff * 1.4
ff = diff * 1.2
gg = diff * 0.9
hh = 0.7 * diff
If underlying < strik Then
penetP = diff
ElseIf underlying < strik And diff > 0 And prod > 0 Then
penetP = gg
ElseIf under > strik And diff > 0 And prod > 0 Then
penetP = cor * under
ElseIf Application.WorksheetFunction.Max(prod, diff) < zer Then
penetP = 0
End If
Nex:
End Function
--------------------------------------
Sub print_grid_percent_one_page()
'
' print_grid_percent_one_page Macro
'
'
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "Returns Broken Down by Allocation"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = True
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,1,,,TRUE,,FALSE)"
End Sub
Sub Macro3()
'
' Macro3 Macro
'
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Range("DA1229:EK1236").Select
Range("EK1236").Activate
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,1,,,TRUE,,FALSE)"
Range("b1:c2").Select
Application.ScreenUpdating = True
End Sub
Sub Macro4()
'
' Macro4 Macro
'
'
Range("DB1230:EK1236").Select
Range("EK1236").Activate
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,1,,,TRUE,,FALSE)"
Range("b1:c2").Select
End Sub
Sub GoHome()
'
' GoHome Macro
'
'
Range("B1").Select
End Sub
Sub CreateChart()
Dim MyChart As Chart
Set MyChart = ActiveSheet.Shapes.AddChart(xlLineMarkers).Chart
End Sub
Sub ChartSlideShow()
Dim Cht As ChartObject
Dim UserSheet As Worksheet
Set UserSheet = ActiveSheet
Application.DisplayFullScreen = True
Application.DisplayAlerts = False
For Each Cht In UserSheet.ChartObjects
Application.ScreenUpdating = False
' Delete old chart sheet if it exists
On Error Resume Next
Charts("ChartTemp").Delete
On Error GoTo 0
' Copy embedded chart and move it
UserSheet.Activate
Cht.Chart.ChartArea.Copy
ActiveSheet.Paste
ActiveChart.Location Where:=xlLocationAsNewSheet, _
Name:="ChartTemp"
' Show the chart sheet and prompt for next one
Application.ScreenUpdating = True
If MsgBox("OK for next chart, Cancel to stop.", _
vbQuestion + vbOKCancel) = vbCancel Then Exit For
Next Cht
' Clean up
On Error Resume Next
Charts("ChartTemp").Delete
On Error GoTo 0
Application.DisplayFullScreen = False
Application.DisplayAlerts = True
UserSheet.Activate
End Sub
--------------------------------------
