You can change the "right click menu" or "Popup menu" or "Context Menu" in Microsoft Excel. For example, remove the "Pick from drop-down list...", "Add Watch" and "Hyperlink..." or even add in Macro you want. You may choose your own Icon from the available list. :)
Google "Excel context menu" and you can learn from there. But this required some programming.
Below is my version of menu. I set up for (a) General right click (b) Query (c) Pivot Table.
Private Sub ResetContentMenu()
Dim cBut As CommandBarControl
Dim myControl As CommandBarControl
On Error Resume Next
'Format right click content - General
With Application.CommandBars("Cell")
.Reset
.Controls("Pick from drop-down list...").Visible = False
.Controls("Add Watch").Visible = False
.Controls("Create List...").Visible = False
.Controls("Hyperlink...").Visible = False
.Controls("Look up...").Visible = False
.Controls.Add Type:=msoControlButton, ID:=443
.Controls.Add Type:=msoControlButton, ID:=458
.Controls.Add Type:=msoControlButton, ID:=852
Call AddMacroContentMenu("Cell", 557, "PERSONAL.XLSB!RemoveFormula")
.Controls(.Controls.Count).BeginGroup = True
Call AddMacroContentMenu("Cell", 578, "PERSONAL.XLSB!TrimColumn")
Call AddMacroContentMenu("Cell", 440, "PERSONAL.XLSB!AutoFit")
Call AddMacroContentMenu("Cell", 578, "PERSONAL.XLSB!TrimColumn")
Call AddMacroContentMenu("Cell", 630, "PERSONAL.XLSB!ConvertDate")
Call AddMacroContentMenu("Cell", 288, "PERSONAL.XLSB!CheckActiveCellInfo")
Call AddMacroContentMenu("Cell", 222, "PERSONAL.XLSB!FilterString")
.Controls.Add Type:=msoControlButton, ID:=293
.Controls(.Controls.Count).BeginGroup = True
.Controls.Add Type:=msoControlButton, ID:=294
.Controls.Add Type:=msoControlButton, ID:=296
.Controls.Add Type:=msoControlButton, ID:=297
End With
With Application.CommandBars("Query")
.Reset
Set myControl = .Controls.Add(Type:=msoControlButton, ID:=443)
myControl.BeginGroup = True
.Controls.Add Type:=msoControlButton, ID:=458
Call AddMacroContentMenu("Query", 440, "PERSONAL.XLSB!AutoFit")
Call AddMacroContentMenu("Query", 288, "PERSONAL.XLSB!CheckActiveCellInfo")
Call AddMacroContentMenu("Query", 222, "PERSONAL.XLSB!FilterString")
End With
'Format right click content - Pivot Table
With Application.CommandBars("PivotTable Context Menu")
.Reset
Set myControl = .Controls.Add(Type:=msoControlButton, ID:=443)
myControl.BeginGroup = True
End With
Set myControl = Nothing
On Error GoTo 0
End Sub
Sub AddMacroContentMenu(myComBarName As String, myFaceID As Double, myMacro As String)
'Purpose: link to "SetupCommandBar" macro
Dim cmdButton As CommandBarButton
Dim strMyAction As String
Set cmdButton = Application.CommandBars(myComBarName).Controls.Add(Type:=msoControlButton)
strMyAction = Right(myMacro, Len(myMacro) - InStr(1, myMacro, "!"))
With cmdButton
.FaceId = myFaceID
.Caption = strMyAction
.OnAction = myMacro
.TooltipText = strMyAction
.Style = msoButtonIconAndWrapCaption
End With
Set cmdButton = Nothing
End Sub
Showing posts with label Excel related. Show all posts
Showing posts with label Excel related. Show all posts
Monday, August 5, 2013
Wednesday, July 31, 2013
My Excel Investment Portfolio Scrap Book
This is the enhanced version of stock calculators in the previous post.
New Features:
(1) Allow stimulation/record for multiple purchases or dollar averaging. As shown below, you can input multiple purchases and the average purchase price is auto calculated.
(2) A summary page of total portfolio; included a reminder to cut-loss if the loss of individual stock exceed 7%.
New Features:
(1) Allow stimulation/record for multiple purchases or dollar averaging. As shown below, you can input multiple purchases and the average purchase price is auto calculated.
(2) A summary page of total portfolio; included a reminder to cut-loss if the loss of individual stock exceed 7%.
You can download the excel here:
https://www.dropbox.com/s/7xvtuenyzlb1l39/StockCalculator_v4.xlsxThursday, July 25, 2013
Excel Tips 1
Excel Tips:
(1) To determine the quarter of a particular date, use
formula:
=ROUNDUP(MONTH(A1)/3,0)
(2) To determine the last day of a month, use formula:
=DATE(YEAR(A1),MONTH(A1)+1,0)
(3) To determine no. of days between 2 dates, use hidden
Excel formula:
=DATEDIF(startdate, enddate,""d"")
(4) Instead of using formula: =IF(OR(A1=1,A1=3,A1=5), TRUE,
FALSE)
, use formula =IF(OR(A1={1,3,5}), TRUE, FALSE)
Replace wording in RED with your
specific cell.
Tuesday, July 16, 2013
Excel Macro VBA convert date
Sub ConvertDate()
'Purpose: Change a numeric data to a date format which recognizable by Excel
'It detects the no. of digits for a cell.
'10 digits: 31/12/2010 -> 31-Dec-2010
' 8 digits: 20101231 -> 31-Dec-2010
' 6 digits: 311210 -> 31-Dec-2010
' 5 digits: 61210 -> 06-Dec-2010
Dim i As Double
Dim NoOfRows As Double
Dim ColumnNo As Integer
Dim DataRange As Variant
Dim myString As String
Dim MyDateSetting As String
Dim MyMessage As String
Select Case Application.International(xlDateOrder)
Case 0
MyDateSetting = "MDY"
Case 1
MyDateSetting = "DMY"
Case 2
MyDateSetting = "YMD"
End Select
If MyDateSetting <> "DMY" Then
MyMessage = "Windows date setting: " & MyDateSetting & Chr(13) & " Date Separator: " & Application.International(xlDateSeparator) & Chr(13)
MyMessage = MyMessage & Chr(13) & "You may change setting to DMY before running this script: Control Panel-> Regional and language setting->customize->Date"
MsgBox MyMessage
Exit Sub
End If
For Each myRange In Selection
myString = myRange.Value
If Len(myString) = 8 Then
newDate = DateSerial(Left(myString, 4), Mid(myString, 5, 2), Right(myString, 2))
Else
If Len(myString) = 6 Then
newDate = DateSerial(Right(myString, 2), Mid(myString, 3, 2), Left(myString, 2))
Else
If Len(myString) = 5 Then
newDate = DateSerial(Right(myString, 2), Mid(myString, 2, 2), Left(myString, 1))
Else
If Len(myString) = 10 Then
newDate = DateSerial(Right(myString, 4), Mid(myString, 4, 2), Left(myString, 2))
End If
End If
End If
End If
If (Trim(Len(myString)) <> 0) And (TypeName(myRange.Value) <> "Date") Then
myRange.Value = newDate
myRange.NumberFormat = "[$-409]dd-mmm-yy;@"
End If
Next
End Sub
'Purpose: Change a numeric data to a date format which recognizable by Excel
'It detects the no. of digits for a cell.
'10 digits: 31/12/2010 -> 31-Dec-2010
' 8 digits: 20101231 -> 31-Dec-2010
' 6 digits: 311210 -> 31-Dec-2010
' 5 digits: 61210 -> 06-Dec-2010
Dim i As Double
Dim NoOfRows As Double
Dim ColumnNo As Integer
Dim DataRange As Variant
Dim myString As String
Dim MyDateSetting As String
Dim MyMessage As String
Select Case Application.International(xlDateOrder)
Case 0
MyDateSetting = "MDY"
Case 1
MyDateSetting = "DMY"
Case 2
MyDateSetting = "YMD"
End Select
If MyDateSetting <> "DMY" Then
MyMessage = "Windows date setting: " & MyDateSetting & Chr(13) & " Date Separator: " & Application.International(xlDateSeparator) & Chr(13)
MyMessage = MyMessage & Chr(13) & "You may change setting to DMY before running this script: Control Panel-> Regional and language setting->customize->Date"
MsgBox MyMessage
Exit Sub
End If
For Each myRange In Selection
myString = myRange.Value
If Len(myString) = 8 Then
newDate = DateSerial(Left(myString, 4), Mid(myString, 5, 2), Right(myString, 2))
Else
If Len(myString) = 6 Then
newDate = DateSerial(Right(myString, 2), Mid(myString, 3, 2), Left(myString, 2))
Else
If Len(myString) = 5 Then
newDate = DateSerial(Right(myString, 2), Mid(myString, 2, 2), Left(myString, 1))
Else
If Len(myString) = 10 Then
newDate = DateSerial(Right(myString, 4), Mid(myString, 4, 2), Left(myString, 2))
End If
End If
End If
End If
If (Trim(Len(myString)) <> 0) And (TypeName(myRange.Value) <> "Date") Then
myRange.Value = newDate
myRange.NumberFormat = "[$-409]dd-mmm-yy;@"
End If
Next
End Sub
Monday, July 15, 2013
Excel Macro VBA open current file path
Sub OpenFilePath()
'Purpose: Open the path where the current workbook is saved, using window explorer
'InputBox "Document Path", "Show DocumentPath", ActiveWorkbook.FullName
'call window explorer
'MsgBox ActiveWorkbook.Path
retval = Shell("C:\WINDOWS\explorer.exe /e ,/select," & ActiveWorkbook.FullName, vbNormalFocus)
End Sub
'Purpose: Open the path where the current workbook is saved, using window explorer
'InputBox "Document Path", "Show DocumentPath", ActiveWorkbook.FullName
'call window explorer
'MsgBox ActiveWorkbook.Path
retval = Shell("C:\WINDOWS\explorer.exe /e ,/select," & ActiveWorkbook.FullName, vbNormalFocus)
End Sub
Excel Macro VBA remove extra space
Sub TrimColumn()
'Purpose: Remove extra empty space of data in each cell for the whole column
'Example: "abc " -> "abc"
Dim i As Double
Dim NoOfRows As Double
Dim ColumnNo As Integer
Dim DataRange As Variant
Dim myString As String
NoOfRows = ActiveSheet.UsedRange.Rows.Count
ColumnNo = ActiveCell.Column
DataRange = Range(Cells(1, ColumnNo), Cells(NoOfRows, ColumnNo))
If IsEmpty(DataRange) = True Then
Exit Sub
End If
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
End With
For i = 1 To NoOfRows
myString = DataRange(i, 1)
myString = Trim(myString)
DataRange(i, 1) = myString
Next
Range(Cells(1, ColumnNo), Cells(NoOfRows, ColumnNo)) = DataRange
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayStatusBar = True
End With
End Sub
'Purpose: Remove extra empty space of data in each cell for the whole column
'Example: "abc " -> "abc"
Dim i As Double
Dim NoOfRows As Double
Dim ColumnNo As Integer
Dim DataRange As Variant
Dim myString As String
NoOfRows = ActiveSheet.UsedRange.Rows.Count
ColumnNo = ActiveCell.Column
DataRange = Range(Cells(1, ColumnNo), Cells(NoOfRows, ColumnNo))
If IsEmpty(DataRange) = True Then
Exit Sub
End If
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
End With
For i = 1 To NoOfRows
myString = DataRange(i, 1)
myString = Trim(myString)
DataRange(i, 1) = myString
Next
Range(Cells(1, ColumnNo), Cells(NoOfRows, ColumnNo)) = DataRange
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayStatusBar = True
End With
End Sub
Excel Macro VBA suffix minus sign to become prefix
Sub RemoveMinus()
'Purpose: Move the minus sign suffix on a number to the front.
'Example: 235- become -235
Dim rngStep As Range
On Error Resume Next
For Each rngStep In ActiveSheet.UsedRange
If Right(rngStep.Value, 1) = "-" Then
rngStep.Value = "-" & Mid(rngStep.Value, 1, Len(rngStep.Value) - 1)
End If
Next
On Error GoTo 0
End Sub
'Purpose: Move the minus sign suffix on a number to the front.
'Example: 235- become -235
Dim rngStep As Range
On Error Resume Next
For Each rngStep In ActiveSheet.UsedRange
If Right(rngStep.Value, 1) = "-" Then
rngStep.Value = "-" & Mid(rngStep.Value, 1, Len(rngStep.Value) - 1)
End If
Next
On Error GoTo 0
End Sub
Tuesday, July 9, 2013
Dividend Yield vs Share Price
As you known,
Assuming Dividend ($) is fixed. For 1% drop in Share Price ($),
Assuming Dividend ($) is fixed. For 1% drop in Share Price ($),
So, for n% drop in Share Price, Dividend Yield (%) will increase
For example, if dividend yield is 5%, assume dividend ($) is fixed, a 1% drop in share price will increase dividend yield of 0.05% 
. For a 7% drop in share price, the dividend yield will increase by 0.38% 
. For a 7% drop in share price, the dividend yield will increase by 0.38%
As shown below, for a share to increase dividend yield from 5% to 6%, the share price need to fall more than 16%!
Monday, July 8, 2013
Singapore IRAS Income Tax Calculator
I created this IncomeTax Calculator for submission of my Singapore IRAS Income Tax. I find IRAS website calculator too complicated.
My version of Singapore IRAS Income Tax calculator:
https://www.dropbox.com/s/xej50h9pe4g7pno/IncomeTaxCalculator_v3.xls
My version of Singapore IRAS Income Tax calculator:
https://www.dropbox.com/s/xej50h9pe4g7pno/IncomeTaxCalculator_v3.xls
Present Value / Present Value Annuity
Present Value("PV") is the opposite of Future Value. Take previous example, in order to have $216,623 at 10 years later and you willing to invest $11,000 yearly in an investment that give 6% return, how much capital you need? (Excel formula: PV(6%,10,11000,-216623,0)=$40,000)
You can also use Present Value to estimate inflation. In short, inflation means how fast you money shrinking. Example inflation of 3%: your $100 now will become $100 x (100%-3%) = $97 next year. $97 x (100%-3%) = $94. From the graph below: $100 will become $72, $64, $57 for 3%, 4% and 5% inflation respectively.
Test: If you think you can retire with S$1,000 (money now), how much money you need in 20 years later due to 3% inflation?
Answer: Use formula "FV": FV(3%,10,,-1000,0) = $1,344
For $2000(money now) and 3% inflation: FV(3%,10,,-2000,0) = $2,688
For $1000(money now) and 4% inflation: FV(4%,10,,-1000,0) = $1,480
You can download Present Value Excel from:
https://www.dropbox.com/s/dwst6cnyox75530/PresentValue.xlsx
Test: If you think you can retire with S$1,000 (money now), how much money you need in 20 years later due to 3% inflation?
Answer: Use formula "FV": FV(3%,10,,-1000,0) = $1,344
For $2000(money now) and 3% inflation: FV(3%,10,,-2000,0) = $2,688
For $1000(money now) and 4% inflation: FV(4%,10,,-1000,0) = $1,480
You can download Present Value Excel from:
https://www.dropbox.com/s/dwst6cnyox75530/PresentValue.xlsx
Future Value / Future Value Annuity
If you just want to see the result of X years later, you don't need to use previous "Investment.xls". You can use Excel "FV" formula. That should give you the same result of "Sub Total" in "Investment.xls".
Here, let me explain a few terms:
Here, let me explain a few terms:
- Compound Interest: heard of loan shark / Ah Long? 利滚利? Yes, that mean the interest is calculated based on (previous interest + capital).
- Future value : Capital money you have now, let it rolled by compound interest, X years later, the number you can get is future value.
- Future value annuity: Capital money you have now + you invest certain $ every year. Let it rolled by compound interest, X years later, the number you can get is future value annuities.
You may download the Excel :
Subscribe to:
Posts (Atom)