Saturday, July 24, 2010

Excel Macros : Send Email with VBA

The Code I am sharing with you today is capable of sending active sheet of your workbook through outlook mail to email ID specified by you. You will not get any warning messages and the email will be sent using outlook profile available on your machine.

This code saves active sheet to temp file and then email it to the recipient. Once the mail has been sent the temp file is deleted by the code.

You will need to copy this code to regular VBA module of your workbook

Sub EmailActiveSheetWithOutlook()

Dim oApp, oMail As Object, _
tWB, cWB As Workbook, _
FileName, FilePath As String

Application.ScreenUpdating = False

'Set email id here, it may be a range in case you have email id on your worksheet

Mailid = "yogesh@yogeshguptaonline.com"

'Write your email message body here , add more lines using & vbLf _ at the end of each line

Body = "Please find enclosed " & vbLf _
& vbLf _
& "Thanks & Regards"


'Copy Active Sheet and save it to a temporary file

Set cWB = ActiveWorkbook
ActiveSheet.Copy

Set tWB = ActiveWorkbook
FileName = "Temp.xls" 'You can define the name
FilePath = Environ("TEMP")

On Error Resume Next
Kill FilePath & "\" & FileName
On Error GoTo 0
Application.DisplayAlerts = False
tWB.SaveAs FileName:=FilePath & "\" & FileName, FileFormat:=56
Application.DisplayAlerts = True

'Sending email through outlook

Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = Mailid
.Subject = "Update Message Subject here"
.Body = Body
.Attachments.Add tWB.FullName
.send
End With

'Delete the temporary file and restore screen updating

tWB.ChangeFileAccess Mode:=xlReadOnly
Kill tWB.FullName
tWB.Close SaveChanges:=False
cWB.Activate
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing

End Sub



Download file with VBA code to send active sheet through outlook

Monday, May 31, 2010

Excel Formula : Calculating Age

Today I am sharing with a long formula for calculating age based in Date of Birth as input.

=YEAR(DATE(YEAR(TODAY())-YEAR(A1),MONTH(TODAY())-MONTH(A1)+1,DAY(TODAY())-DAY(A1)+1))-1900&" Years "&IF(MONTH(DATE(YEAR(TODAY())-YEAR(A1),MONTH(TODAY())-MONTH(A1)+1,DAY(TODAY())-DAY(A1)+1))-1=0,"",MONTH(DATE(YEAR(TODAY())-YEAR(A1),MONTH(TODAY())-MONTH(A1)+1,DAY(TODAY())-DAY(A1)+1))-1&" Months ")&IF(DAY(DATE(YEAR(TODAY())-YEAR(A1),MONTH(TODAY())-MONTH(A1)+1,DAY(TODAY())-DAY(A1)+1))-1=0,"",DAY(DATE(YEAR(TODAY())-YEAR(A1),MONTH(TODAY())-MONTH(A1)+1,DAY(TODAY())-DAY(A1)+1))-1&" Days")

This formula calculates age of a person with the accuracy of exact years , months and days

This considers that the Date of Birth is available at Cell A1 of the worksheet. You will need to replace this

Download excel file containing formula to calculate age based on Date of Birth

Sunday, April 18, 2010

Create Range Name in Excel

Today I am sharing quickest way to create Range Name in Excel. Just 3 easy steps

1. Select the cell(s) you want to name
2. Type Range name in the name box
3. Press Enter

Create Range Name in Excel



The following is a list of syntax rules that you need to be aware of when you create and edit names.

Valid characters The first character of a name must be a letter, an underscore character (_), or a backslash (\). Remaining characters in the name can be letters, numbers, periods, and underscore characters.

Cell references disallowed Names cannot be the same as a cell reference, such as Z$100 or R1C1. Spaces are not valid Spaces are not allowed as part of a name. Use the underscore character (_) and period (.) as word separators, such as, Sales_Tax or First.Quarter.

Name length A name can contain up to 255 characters.

Case sensitivity Names can contain uppercase and lowercase letters. Excel does not distinguish between uppercase and lowercase characters in names. For example, if you created the name Sales and then create another name called SALES in the same workbook, Excel prompts you to choose a unique name

Check out screen cast below to see it happening.

Create Range Name in Excel


Named ranges is part of defined names in excel. It is just not limited to a cell on the worksheet or range of cells, it can also be a constant or a formula in your workbook.

It has many uses in Excel, some of them are :-


1. Make your formulas much easier to understand.
2. Refer to dynamic ranges in excel by creating dynamic range names
3. Can be used in data validation based on contents on another worksheet
4. Can be used for conditional formatting based on contents on another worksheet.
5. These are best used in Excel Macros. It makes your macros more robust
6. Use them as constant value without referring to contents on your worksheet.

Will be covering some of the topics in my upcoming posts, so stay tuned to learn more uses of defined names in excel.

Saturday, April 10, 2010

Add Spin Buttons Active X Excel

In my previous posts I have shared EMI Calculator with you. This was mode using Excel PMT function and Spin Buttons ActiveX Controls in Excel. In this post I am sharing how to add spin buttons ActiveX controls to excel worksheet.

Add Spin Buttons Active X Excel

Step 1 Have Developer Tab visible in your Excel 2007. In case you already have it proceed to step 2
Step 2 Click on Insert under controls group
Step 3 Click on Spin Buttons under ActiveX Controls
Step 4 Draw Spin Button on your worksheet.
Step 5 Rename the Spin Button Object
Step 6 Add VBA code to the Spin Button

Checkout Screen Cast Below

Add Spin Buttons Active X Excel



In this screen cast we have added spin button next to loan amount and renamed the spin button object as Loan
Similarly add two more spin buttons next to Interest Rate and Years. Rename them as Interest and Years respectively.

To make these buttons work we need to add VBA code. Separate macros are required for each button that is why we have renamed the spin buttons. It is to give them a name that can be related later on by us when we look at the macro code. Macro code will be using the names we have given to them

Now to add the VBA code , double click on the spin button object, it will open VBA editor. Copy following VBA code to worksheet module


Private Sub Loan_SpinDown()
With Range("C4")
.Value = WorksheetFunction.Max(100000, .Value - 100000)
End With
End Sub

Private Sub Loan_SpinUp()
With Range("C4")
.Value = WorksheetFunction.Min(10000000, .Value + 100000)
End With
End Sub

Private Sub Interest_SpinDown()
With Range("C5")
.Value = WorksheetFunction.Max(0.03, .Value - 0.0025)
End With
End Sub

Private Sub Interest_SpinUp()
With Range("C5")
.Value = WorksheetFunction.Min(0.25, .Value + 0.0025)
End With
End Sub
Private Sub Years_SpinDown()
With Range("C6")
.Value = WorksheetFunction.Max(1, .Value - 1)
End With
End Sub

Private Sub Years_SpinUp()
With Range("C6")
.Value = WorksheetFunction.Min(25, .Value + 1)
End With
End Sub



With this your EMI Calculator with Spin Buttons ActiveX Controls is ready

Visit EMI Calculator page if you want to download excel file complete with macros and Spin Buttons Activex controls

Show Developer Tab in Excel 2007 Ribbon

In case you are working with ActiveX Controls or Macros in Excel , you need to have Developers Tab visibile in your Excel 2007. When you start using Excel 2007, developers Tab is not visible , however you can set it visible with following steps

Show Developer Tab in Excel 2007 Ribbon

Step 1 - Click MS Office Button
Step 2 - Click Excel Options
Step 3 - Click Populor
Step 4 - Tick Show Developer Tab in the Ribbon check box
Step 5 - Click Ok

Friday, April 2, 2010

Excel Formula : PMT Function

In my previous post I shared EMI Calculator with you. In this post I am sharing how to make EMI Calculator. This has been done using PMT Function in excel to calculate EMI amount and Spin Buttons ActiveX Controls to fine tune the amounts.

EMI Calculator



Using PMT Function in Excel


PMT Function Calculates the payment for a loan based on constant payments and a constant interest rate. For calculating EMI you need 3 inputs.

Loan Amount , Annual Interest Rate, Loan Period in Years. Using these figures EMI can be calculated with PMT Function in Excel

EMI Calculator


Syntax : PMT(RATE,NPER,PV,FV,TYPE)

RATE : is the interest rate for the loan. In case you are making monthly payments devide the annual rate by 12 to get monthly rate.

NPER : is the total number of payments for the loan. When payments are made on monthly basis you need to multiply number of years with 12 to arrive at total number of payments.

PV : is the present value, or the total amount that a series of future payments is worth now; also known as the principal. We take this figure as (-) Negative in our formula since it is receipt of funds.

FV : is the future value, or a cash balance you want to attain after the last payment is made. If fv is omitted, it is assumed to be 0 (zero), that is, the future value of a loan is 0. In our formula we omit this figure as we need to reach zero balance at the end of term.

Type : is the number 0 (zero) or 1 and indicates when payments are due. If payments are due at the end of the period use 0 or omit this figure. use 1 if payments are made at the beginning of the period. In our formula we have omitted this.

We have calculated our figures with following formulas

EMI : =PMT(Interst/12,Years*12,-LoanAmt)

Total Amount with Interest - This is total outgo during the loan term. This can be calculated using : = EMI*Years*12

Flat Interest Rate : = (Total Amount with Interest - LoanAmt)/LoanAmt/Years : Many financiers talk about Flat interest rate while landing money. They calculate simple interest on entire loan amount for entire period of the loan. Many people go for the loan without understanding the actual interest rate. Flat interest rate looks very attractive as it is much lower than the actual interest rate which is calculated on reducing balance. You can see the difference in the figures above. So be careful while borrowing on flat interest rate.

In next post I will cover Adding Spin Buttons ActiveX Controls to Worksheet.

Monday, March 22, 2010

EMI Calculator

My friend is taking a loan to buy a house and he asked me what will be my EMI. He knew following figures and was curious to know his EMI

Loan Amount
Annual Interest Rate
Loan Period - Years

I quickly calculated EMI using PMT function in excel. This triggered me an idea of making a EMI calculator and sharing it with all of you.
EMI Calculator

Equated Monthly Installments are commonly knows as EMI. As per business dictionary EMI is "Hire purchase, lease, or loan -repayment installments that are constant in amount, and are usually collected in advance as post-dated checks"

Download EMI Calculator Excel file to know your EMI

Input your figures to find out resultant EMI. Use spin buttons to fine tune your results

In next post I will discuss how to make EMI Calculator. This will be about adding Spin Buttons ActiveX controls to worksheet and PMT function

Wednesday, March 17, 2010

Excel Formula : Subtotal Excel

Most of the time in our reporting we need to do subtotals followed by Grand total at the end of report. I have seen many people using SUM function for subtotals in between and then adding individual cells for calculating grand total at the end. There is nothing wrong with this method if you use it very carefully so that you do not miss any item while calculating grand total at the end.

However better approach is to use Excel Subtotal function for calculating Subtotal and Grand Totals.

Subtotal Excel

Image above is showing column B with the Subtotal formula and resultant values with this formula. You may notice that when we use subtotal function for calculating Grand Total, it ignores the values resulting from subtotal function within its range. This method ensures that we do not miss any item while doing Grand Totals for our reports thus higher accuracy.

This becomes more helpful when you edit your report after some time to insert another subtotal. You do not need to remember to correct the final formula calculating the Grand Total.

Another advantage of using Subtotal function is that you need not to recalculate your formulas when used with filteres. This function ignores the values hidden by the filters and considers the values in the visible rows only.

Subtotal can be used for various type of calculations based on what do you want this fucntion to do for you. Syntex for this function is

SUBTOTAL(function_num, ref1, ref2, ...)

Following function numbers can be used in Subtotal function

I have used "9" in my example above for sum you can change it as per your required working.


Function_num
(Incl hidden values)
Function_num
(Excl hidden values)
Function
1101AVERAGE
2102COUNT
3103COUNTA
4104MAX
5105MIN
6106PRODUCT
7107STDEV
8108STDEVP
9109SUM
10110VAR
11111VARP

Monday, March 8, 2010

Format Numbers : Excel Currency Format

You can add currency symbol to your numbers in excel.

Open Number Format dialog box using Format Cells option or just press Ctrl+1

1. Click Accounting
2. Choose currency symbol from drop down

Format Numbers : Excel Currency Format



In case you do not get your currency symbol from drop down, add your symbol using custom formating option in the same dialogbox
1. Click Custom
2. Type - "Rs "#,##0_);[Red]("Rs "#,##0)

I use "Rs " to show numbers in Indian Currency. You can replace it with your symblol.

Format Numbers : Excel Currency Format

Sunday, March 7, 2010

Pivot Tables : P&L reporting for Multi Location Organisation

I have recently started a series via guest posts on pointy haired dilbert famous excel blog also known as PHD or Chandoo.org. This blog is run by Chandoo a excel blogger and Microsoft excel MVP. Most of you must be knowing chandoo, those who do not know about him can know more about chandoo.

In this series we are covering on how to manage Profit and Loss (P&L) account reporting for Multi Location organization.

P&L Report using Pivot Table


During this series our aim is to learn how we can do our P&L reporting on various dimensions with few clicks.

We are using Pivot Tables for our reporting purpose and will setup P&L report of a Retails chain with multiple locations divided into various regions.

Topics coverted in this series are :

1. Data sheet structure for Preparing P&L using Pivot Tables
2. Preparing P&L Pivot Table using Data sheet
3. Adding Calculated Fields to Pivot Table P&L
4. Exploring Pivot Table P&L Reports
5. Preparing Quarterly and Half yearly P&L using grouping option
6. Budget V/s Actual report using Pivot

Do not think that series is only about the Profit and Loss Account. This series is also about PivotTables. We will cover many of PivotTable tricks during our series. I hope you will be able to use those tricks elsewhere also.

Follow this series on PHD, I am sure that at the end of this series you will be able to do your P&L reporting on various dimentions with just few clicks.

Thursday, March 4, 2010

Excel VBA : Deploy Macros Found Elsewhere

Today I am sharing various ways to add macros found elsewhere to a Excel file where that macro is to be deployed. Will be covering 6 ways to add macro code to your excel file.

1. Excel VBA : Add code to a Regular Module
2. Excel VBA : Add code to WorkBook Module
3. Excel VBA : Add code to Worksheet Module
4. Excel VBA : Copy Module from Existing Workbook
5. Excel VBA : Copy Forms from Existing Workbook
6. Excel VBA : Import code from .bas file

Excel VBA : Add code to a Regular Module

-Copy code from the source
-Open the workbook where you need to deploy this code
-Press ALT+F11 (Keep ALT key pressed while pressing F11 key)
-Click Insert > Module (Shortcut ALT+I+M)
-Paste macro code Click Edit > Paste (Shortcut CTRL+V) in right window where cursor is

See screencast below for Alternate method using right click menu through mouse.
Excel VBA : Add code to a Regular Module

Excel VBA : Add code to WorkBook Module

Some macros are event based macros and get activated as soon as particular event happens. Events which are universally applicable to the entire workbook are called workbook events. These macros will run once a particular event happens in a particular workbook. Typical example of such macros are Auto Open / Auto Close macros

-Copy code from the source
-Open the workbook where you need to deploy this
-Press ALT+F11 (Keep ALT key pressed while pressing F11 key)
-Double Click on ThisWorkbook object
-Paste macro code Click Edit > Paste (Shortcut CTRL+V) in right window where cursor is

See screencast below
Excel VBA : Add code to WorkBook Module

Excel VBA : Add code to Worksheet Module

Some of event based macros get activated as soon as particular event happens on a particular worksheet within the workbook. These are the macros which will run on a event in particular worksheet. Typical example of such macros are Worksheet Select / Worksheet Change macros

-Copy code from the source
-Open the workbook where you need to deploy this
-Press ALT+F11 (Keep ALT key pressed while pressing F11 key)
-Double Click on Worksheet object (Choose particular worksheet where you want to deploy the code)
-Paste macro code Click Edit > Paste (Shortcut CTRL+V) in right window where cursor is

See screencast below
Excel VBA : Add code to Worksheet Module

Excel VBA : Copy Module from Existing Workbook

You may have the code in existing workbook (Source) with you or recently downloaded from Internet. Following steps will deploy it to new workbook (Target)
-Open both the Workbooks (Source and Target)
-Press ALT+F11 (Keep ALT key pressed while pressing F11 key)
-In Left window of project explorer find Source workbook
-Select the source module
-Drag it to the Target workbook

See screencast below
Excel VBA : Copy Module from Existing Workbook

Excel VBA : Copy Forms from Existing Workbook

Steps and requirement is similar to copy code from existing workbook

-Open both the Workbooks (Source and Target)
-Press ALT+F11 (Keep ALT key pressed while pressing F11 key)
-In Left window of project explorer find Source workbook
-Select the Form to be copied
-Drag it to the Target workbook

See screencast below
Excel VBA : Copy Forms from Existing Workbook

Excel VBA : Import code from .bas file

Some time you may get code in downloadable file with extention BAS. This is visual basic file .bas , you can import this to your workbook.

-Open your Workbook
-Press ALT+F11 (Keep ALT key pressed while pressing F11 key)
-In Left window of project explorer find Source workbook
-Click File > Import (CTRL+M)
-Choose downloaded VB file (*.BAS , *.FRM, *.CLS)
-Click Open

See screencast below
Excel VBA : Import code from .bas file

Friday, February 12, 2010

Excel Sort Dates by Birthday

Today's post is in response to comment by Donna.

Problem on hand is to sort data based on birthday of a person. If you sort it on the date of birth it has year also and you will not be able to sort them by month and date.

One of the possible solution is to drop the Year and then sort them. You will need to add one more column to your data as sort key and use following formula considering that you have Date of Birth in Cell "B2"

=TEXT(B2,"MMDD") will convert 02-Dec-50 as 1202 and 24-Sep-89 as 0924. Now if you sort your data based on new column "Sort Key" on ascending manner, you will get 24-Sep-89 before 02-Dec-50

Photobucket



You will be able to get this result only if the date of birth in your data is a real date. In case not you will need to convert text date to real dates

Use following formula to know Birthday during current year

=--TEXT(B2,"DD/MMM")

You will get error in case birthday is 29-Feb and current year is not a leap year. I suppose this is correct as person will not have birthday every year.

There are couple of other solutions to the sort dates on birthday , you can share one by way of comments if you know

Monday, February 1, 2010

Excel Formula : Sum top 5 in unsorted range

Today I am sharing a formula to sum top 5 values in an unsorted range.

=SUMPRODUCT(LARGE(Data,ROW(1:5)))

See the screen cast below to know secret behind this formula.

Photobucket

Actually we are using array formula to find top 5 values , then summing them to find the sum of top 5 values in unsorted range.

From the screen cast you can see that

1. We are entering this formula using sumproduct, which is shortcut to enter array formulas in excel.
2. Data is a named range A3 to B36
3. We are using excel function Large to find Top values.
4. Row(1:5) - is is shortcut to create an array of numbers {1,2,3,4,5} as Kth position

This leads to find top 5 values in unsorted range and then summing them.

Food for thought :

Just change Row(1:5) to Row(1:10) you will be able to find Top 10 values.

Or Change Large with small to find out bottom 5 values.

Download Excel file with formula to sum top 5 values in an unsorted range

to play furhter with this formula

Saturday, January 16, 2010

Excel Formula : Closest Match

Arun Singla one of my blog reader has sent me Excel Formula in response to my previous post Custom Function : Excel Closest Match using VBA.

Formula sent by Arun gives similar results as achieved by Custom Function using VBA. I am sharing the formula with you.

For getting less than equal to value
=IF(COUNTIF(Data,Target)>=1,Target,SMALL(Data,COUNTIF(Data,"<"&Target)))
For getting greater than equal to value
=IF(COUNTIF(Data,Target)>=1,Target,LARGE(Data,COUNTIF(Data,">"&Target)))

In above formula : Data is unsorted data range name, target is the named range having target value.

Now let me explain how does this formula works. I will explain first formula which calculates less than equal to value.

Step 1 - Formula calculates the number of values matching target value using countif function of excel. COUNTIF(Data,Target) gives the total number of values matching exactly with the target. In case you get even one value matching with the target, you return the target as closest match, no need for further working.

Step 2 - In case formula does not get matching value at step 1 , it moves to find the closest match. SMALL(Data,COUNTIF(Data,"<"&Target)) Returns the k-th smallest value in a data set. COUNTIF(Data,"<"&Target) gives us total number of data points less than target. We are using this as k-th smallest value which is closest match less than the target value. I hope this explanation is not confusing to you. Check out the file with this formula to find closest match in excel to understand it better.

Thursday, January 14, 2010

Custom Function : Excel Closest Match using VBA

Some days back I got a mail from Kevin asking for how to get closest match in a list sorted in acending order

Hi Yogesh, is there a way for me to find the
closest match (greater than or equal to) to
a value in a list? The list is sorted in
ascending order and cannot be changed.
Regards,
Kevin

I responded to him with a Custom Function capable to Finding Closest Match as per his requirement. This worked as the list was sorted in ascending order. He sent me a thanks note for this.

However this left certain questions in my mind such as

1. What if the list is not sorted, Custom function should be able to do this in unsorted list.

2. He wanted greater than equal to value, however it should be able to handle less than equal to value also

With these things in my mind I worked out another custom function which works with unsorted data range and is capable of finding both type of closest match in excel.

I am sharing updated Custom Function with all of you. You will need to copy this code to regular VBA module of your workbook

Function cmatch(ByVal n, l As Range, Optional Switch As Integer = 1)
'**************************************************************************************
'* Custom Function by Yogesh Gupta , yogesh@yogeshguptaonline.com *
'* Custom Function to find Closest Match in an unsorted data *
'* use Switch value as -1 in case you want less than equal to closest match *
'* Default value for Switch is 1, and will find greater than equal to closest match *
'**************************************************************************************

If Switch = 1 Then ' This will get greater than equal to value

a = Application.Max(l)
If a < n Then ' Error in case list does not have value greater than or equal to n
cmatch = "#N/A"
Else
For Each c In l
If c >= n Then
If c < a Then a = c
End If
Next c
cmatch = a
End If

ElseIf Switch = -1 Then ' This will get less than equal to value

a = Application.Min(l)
If a > n Then ' Error in case list does not have value less than or equal to n
cmatch = "#N/A"
Else

For Each c In l
If c <= n Then
If c > a Then a = c
End If
Next c

cmatch = a
End If

Else

cmatch = "#N/A" ' Error in case of Invalid Input

End If

End Function


Download Excel file with Custom Function to Find Closest Match to see how it works

Friday, January 1, 2010

Excel Macros : Excel Date Picker

This is first post of the year 2010, I wish all my blog readers a very happy and prospurous year. Today I am sharing Excel Date Picker Utility with you. Following picture will demonstrate some to the capabilities of this utility.

Photobucket



This utility will help you with following

1. In case you select a cell with date, or select any cell around the cell with a date. It will show floating button on the left side of the cell. If you click on the floating button it will show popup calender.
2. In case the cell already has a date , the calendar will show same date by default, else it will show current date.
3. You can jump the months by click on the month value on the popup calendar.
4. Click on the year will show spin buttons next to it and you can change year easily with spin buttons.
5. When you click on the date in popup calander, it will insert date clicked to the selected cell
6. You can also use Ctrl+Shift+d to show popup calender on your screen.
7. In case you get pop up calander and you do not want to click any date, just press Esc to close the pou up calendar.

This utility could be usefull in following ways

1. Many people end up entering date in text format as some time it is difficult to enter the date in correct computer readable format. With the popup calander, system takes care of the proper date entry.
2. Some times you have to get data from other users and you want them to enter dates in proper format so that rest of the worksheet can use those date inputs. With this utility you can be assured about this issue.

You may figure out many more usage based on your needs. The VBA code for Excel date Picker is available in the downloadable file. You can further modify the code as per your needs.

Now how to use this Excel Date Picker Utility



1. Download file and save it as Excel Addin on your machine.
2. You will need to copy this code to worksheet module of your workbook.

You will need to add this code to show the Floating button. This code will creat the button in case it does not exist on it. All other features like cell menu on right click and popup calender on Ctrl+Shift+d will be available in case you do not add this code by saving download able file as Excel Addin on your machine. I am suggesting this because I still need to learn how to trigger worksheet selection change event with a vba code in addin.


Private Sub FloatingButton_Click()
Calander.Show
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Application.CutCopyMode = 1 Then
Exit Sub
ElseIf Target.Cells.Count > 1 Then
Exit Sub
Else

Set r = Target
Hasdate = 0

For x = -1 To 1
For y = -1 To 1

On Error GoTo Etrap1

If IsDate(r.Offset(x, y)) Then
Hasdate = 1
Exit For
End If
Rsume1:
Next y
If Hasdate = 1 Then Exit For
Rsume:
Next x

If Hasdate = 1 Then

FloatingButton.Left = r.Offset(0, 1).Left
FloatingButton.Top = r.Top
FloatingButton.Visible = True

Else

If Not FloatingButton.Visible = False Then
FloatingButton.Visible = False
End If

End If

Exit Sub

End If

Etrap1:
If r.Row = 1 Then
Resume Rsume
ElseIf r.Column = 1 Then
Resume Rsume1
End If


End Sub

Private Sub Worksheet_Activate()
Dim s As String
On Error Resume Next
s = ActiveSheet.FloatingButton.Caption
If Err.Number <> 0 Then
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=147.75, Top:=34.5, Width:=15.75, Height:= _
15.75).Select

Selection.Name = "FloatingButton"
ActiveSheet.OLEObjects("FloatingButton").Object.Caption = ""
ActiveSheet.OLEObjects("FloatingButton").Object.BackColor = &H80000005
Range("A1").Select
FloatingButton.Visible = False
End If
On Error GoTo 0

End Sub


However this will not work on the files you send to other users. In that case you need to builtin the entire utility into the file you are sending out.

Following steps will help you to do this.

1. You will need to copy this code to workbook module of your workbook

Private Sub Workbook_Open()
Dim NewControl As CommandBarControl
Application.OnKey "+^{D}", "Module1.ShowCalander"
On Error Resume Next
Application.CommandBars("Cell").Controls("Show Date Picker").Delete
On Error GoTo 0
Set NewControl = Application.CommandBars("Cell").Controls.Add
With NewControl
.Caption = "Show Date Picker"
.OnAction = "Module1.ShowCalander"
.BeginGroup = True
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Cell").Controls("Show Date Picker").Delete
End Sub


2. You will need to copy this code to regular VBA module - Module1 of your workbook

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Private Const GWL_STYLE As Long = (-16)
Private wHandle As Long

Sub ShowCalander()
Calander.Show
End Sub


3. Move form named calander from the downloadable file to your file.

With these steps you can send the file to other users and it will work in similar way as it works on your machine.

In addition you can force users to enable macros while using your file

Download file with Excel Date Picker Utility