Excel Macros : Text to Numbers VBA

Some times you get data which has some numbers surrounded by lots of text or non text characters or space in between text and numbers. Position of the numbers within text is not same in each data line. In such situation you may not be able to apply standard Excel Formulas to extract number from text. In such scenario you will need to use VBA to Extract Number from String. Today I am sharing with you UDF to perform this function. Just for illustration following table will show you capability of this UDF.

Text Data	Extracted Numeric Value
xusdhd 10005000	10005000
AKSID0100050000 A1	100050000
IU EW KFID100050000 A 1	100050000
10005 0000 A1	100050000
01000 A1 B 12	1000

Above Numeric Values have been extracted using simple formula =Number(B3) , In this case text string is in Cell B3. This formula is not available in standard excel functions. To apply this formula You will need to copy this code to regular VBA module of your workbook

'**************************************************************** '* User Defined Function (UDF) to Get Numeric Value from String * '**************************************************************** Function Number(ByVal CurrString As String) Dim temp As String temp = Left(CurrString, 1) Do While Not IsNumeric(temp) If Len(CurrString) <= 1 Then Exit Function Else CurrString = Mid(CurrString, 2) temp = Left(CurrString, 1) End If Loop Number = Val(CurrString) End Function

Download excel file with UDF for Text to Numbers

Excel Formula : Using Vlookup Function

One Golden Rule while working with Excel Formula's is never enter a hard coded value into Formula. If you can calculate a value with a formula, it should not be hard coded into your formula's

Today we will talk about how this is relevant in using Vlookup Function. We all use Vlookup function in our day to day working with the data in Excel. Given below is the Syntex for Vlookup function just for reference purpose.

VLOOKUP(lookup_value, table_array, col_index_num, [range_lookup])



Picture on the above is typical data table used by us. Column C to N are hidden in this just to keep the table visible on screen. We need to get the sales value using vlookup formula. Most of the users (including me till some time back) hardcode col_index_num. Most common use of Vlookup Function for getting data from the table like above will be a formula like this.
=VLOOKUP(B13,B3:P10,15,0)

Here lookup_value is given at Cell B13, table_array is a Range B3:P10, col_index_num is 15 as it is 15th Column starting from Column B, range_lookup is 0 as we are looking for exact match.

In above formula the col_index_num is hard coded. Formula will give correct results till you do not insert or delete columns in between. Once you have done so , all your formulas will not update sales figure but reference some other value.

However with the following formula you can overcome this issue. You can calculate the number of columns with the help of Columns function of Excel.
=VLOOKUP(B13,$B$3:$P$10,COLUMNS(B3:P3),0)

COLUMNS(B3:P3) will be calculated as 15 and in case you insert any column between table_array your formula will change to VLOOKUP(B13,$B$3:$Q$10,COLUMNS(B3:Q3),0). Now columns function withing your formula will be calculated as 16 giving you correct value. This makes your Vlookup function dynamic.

Do refer to my earlier tip on Dynamic Range Names to make table_array also dynamic.

You are welcome to share your way of entering Vlookup function by way of comments to this post.

Excel Macro : Email Address Extract from String

Last week I got a mail from my friend asking for help in extracting email IDs from data available with him. The position of the mail IDs within the text string was not same and he was finding it difficult to us extract email addresses.

I wrote a quick UDF for him which did the job. I am sharing same with you as you may find it use full.

Sample of the data and mail IDs extracted with the UDF is as below



Here is the VBA code to Email Address Extract from String. You will need to copy this code to regular VBA module of your workbook

Function Getmailid(cell As Range) As String Dim Textstrng As String Textstrng = cell.Text Position@ = InStr(1, Textstrng, "@") EmStart = InStrRev(Textstrng, " ", Position@) If EmStart = 0 Then EmStart = 1 EmEnd = InStr(Position@, Textstrng, " ") If EmEnd = 0 Then EmEnd = Len(Textstrng) + 1 mailid = Trim(Mid(Textstrng, EmStart, EmEnd - EmStart)) If Right(mailid, 1) = "." Then Getmailid = Left(mailid, Len(mailid) - 1) Else Getmailid = mailid End If End Function

Download file with VBA code to Email Address Extract from Text String

Excel Macro : Hide Cell Content from Printing

Some times we have some information in worksheet which is we need to input but do not want that information to be printed. With the following macro code you can achieve the desired results

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

Private Sub Workbook_BeforePrint(Cancel As Boolean) Application.EnableEvents = False Cancel = True A = Range("A1").NumberFormat Range("A1").NumberFormat = ";;;" Application.Dialogs(xlDialogPrint).Show Range("A1").NumberFormat = A Application.EnableEvents = True End Sub

As per above code the contents of Range A1 will not be printed, you will need to change this reference to your cell.

Download file with the code to hide cell contents before printing

.

Excel Formula : Sumif Multiple Criteria

This is in continuation of my earlier post on Countif Multiple Criteria The same logic can be extended to calculate sum based on multiple criteria.

In case you have Excel 2007, you can use built in function Sumifs . This will let you add multiple conditions.


In case of Excel 2003 or earlier version using Pivot table will get you the results easily but if You don't have liberty to use Pivot, then you will need formula trick. Consider that you have a data table like this and you need to know what is sales in "North" region by sales man "Ram".

Following sumproduct formula will do the calculation for you.

=SUMPRODUCT(($B$13:$B$28="North")*($C$13:$C$28="Ram")*($E$13:$E$28))

Another way is to write an array formula.
=SUM(($B$13:$B$28="North")*($C$13:$C$28="Ram")*($E$13:$E$28))
However this will need to be confirmed with CTRL+Shift+Enter (CSE)

After CSE formula will show {} in formula bar. This will covert it to an array formula. The formula will look like following picture after CSE in formula bar



I suggest you to use Sumproduct formula as you may find it difficult to enter array formula.

If you see the dialog for sumproduct formula entry you will understand the reasons behind this recommendation. Actually sumproduct is a workaround to enter array formula.



If you see above dialog screen , you will notice

1. When you enter ranges, you are actually entering array's.
2. This formula is entered in single array only to get the results.

If you try to use sumproduct as normal formula to calculate sum based on multiple conditions , you will not get the results.

Actually multiple condistional sum can be calculated using arrays only and sumproduct allows you to enter array's easily and you can over come the difficulty of entering array formula.

Download Excel File having Sumif Multiple Criteria Formulas

Excel Number Format : Indian Style Comma Separation

Yesterday I got a comment asking for custom number format for Indian style comma separation. While I responded to question by providing the custom number format I knew that the answer does not handle the complete range of numbers and can not be applied in all the cases. This forced me to look around for a solution that can be applied for all kind of numbers.

Just for the information of people who are not aware of Indian Style of comma separation, I have produced table below which explains Indian style formatting for various numbers. The basic rule is that first comma separation happens at 3 digits i.e. 1000 then it happens after every 2 digits. Check out table below for better understanding.

Number	Formatted As
10	10.00
100	100.00
1000	1,000.00
10000	10,000.00
100000	1,00,000.00
1000000	10,00,000.00
10000000	1,00,00,000.00
100000000	10,00,00,000.00
1000000000	1,00,00,00,000.00
10000000000	10,00,00,00,000.00
100000000000	1,00,00,00,00,000.00

Soon I realised that there is no single custom format available for handling all kind of number length and we need separate format for it depending upon the number of digits. Doing this manually and accuratly every time is very difficult. This leaves only one option to automate this through a macro. I got a Macro code for doing this and modified and tested that for long numbers.



I am sharing the macro code with you. You will need to select the numbers and run macro to format them as per India style comma sepration.

Sub IndianNumberFormat() For Each c In Selection Select Case Abs(c.Value) Case Is < 100000 c.Cells.NumberFormat = "##,##0.00" Case Is < 10000000 c.Cells.NumberFormat = "#\,##\,##0.00" Case Is < 1000000000 c.Cells.NumberFormat = "#\,##\,##\,##0.00" Case Is < 1000000000 c.Cells.NumberFormat = "#\,##\,##\,##0.00" Case Is < 100000000000# c.Cells.NumberFormat = "#\,##\,##\,##\,##0.00" Case Else c.Cells.NumberFormat = "#\,##\,##\,##\,##\,##0.00" End Select Next c End Sub

For easy application of this code you need to save it as a excel addin or add it to your personal macro book. Adding a custom toolbar for this code will make it easy to apply. You can chage the number of decimal places by changing the number of zeros at the end of custom number format given above.

Excel Number Format : Telephone numbers with leading + sign

This is in continuation of my earlier post Custom Formating - Excel Number Format

Excel does not display the leading + sign entered by users, similarly the leading zeros are also not recoganised by excel. However custom formating trick can help you do this. Refer to the following table, where in Phone number 9971112814 has been formated differently to display different formats for the same cell contents.

91 is country code for India, you can change it to whatever code you want to display the number accordingly.

Format	Displayed as
+91 0000000000	+91 9971112814
+91(0)0000000000	+91(0)9971112814
+91(0)000-000-0000	+91(0)997-111-2814
0091 0000000000	0091 9971112814

Excel Formulas : Countif Multiple Criteria

Many times we need to perform a count based on multiple criteria.

This is very simple if you are using Excel 2007. You have standard excel function Countifs which lets you do the count based on multiple criteria.


But if you are using Excel 2003 this becomes tricky as you do not have any standard function that lets you do this. However you can do it using Pivot Tables. Sometimes you just need the count based on multiple criteria to be put into a report and using Pivot tables for such report may not be a viable option.

In such scenarios you need to go for a workaround using excel formula. Considering you have a data table like this and you want to know the number of customers in North Area serviced by Sales Man by name of Ram.

If you have Excel 2007 then it very simple just use
=COUNTIFS($B$13:$B$28,"North",$C$13:$C$28,"Ram") and it will give you count result 3.

For Excel 2003 users My favorite for such kind of calculation is Sumproduct function and you can do it with the help of following formula.
=SUMPRODUCT(($B$13:$B$28="North")*($C$13:$C$28="Ram"))
This formula will give you result as 3 customers.
You can add as many conditions here but be sure that the height of the range is same for all ranges mentioned in this formula

This actually is a workaround for another method array formula.
=SUM(($B$13:$B$28="North")*($C$13:$C$28="Ram")) confirmed with CTRL+Shift+Enter
Once you confirm this formula with CTRL+Shift+Enter it will add {} to the formula which will be visible in the formula bar only.

Look at the screen cast below to know the difference it make to the normal formula once confirmed as CSE formula. Look for the addtional {} added to formula

Download file having countif multiple conditions formula

You may find it difficult to enter array formula that is why I suggest you to go for SUMPRODUCT method.
To know more about array formulas you can read

Introducing array formulas in Excel

.

Excel Dates : Leap Year or Not a Leap Year

Excel follows Gregorian calendar which was first established in 1582 by Pope Gregory XIII.

To determine whether a year is a leap year, follow these steps:

  1. If the year is evenly divisible by 4, go to step 2. Otherwise, go to step 5. 
  2. If the year is evenly divisible by 100, go to step 3. Otherwise, go to step 4. 
  3. If the year is evenly divisible by 400, go to step 4. Otherwise, go to step 5. 
  4. The year is a leap year (it has 366 days). 
  5. The year is not a leap year (it has 365 days). 

Following formula gives the results based on above steps. This considers that you have stored year in Cell A1 of your worksheet

=IF(OR(MOD(A1,400)=0,AND(MOD(A1,4)=0,MOD(A1,100)<>0)),"Leap Year", "NOT a Leap Year")

Since excel has all these calculations built in , you can just test the last day of the February month and decide based on day value. If it is 29 then Leap Year else NOT a Leap Year.

Following formula gives the results based on above steps. This considers that you have stored year in Cell A1 of your worksheet

=IF(DAY(DATE(A1,3,0))=29,"Leap Year","NOT a Leap Year")

First Formula returns 1900 as "NOT a Leap Year" but second Formula will return it as "Leap Year". This is due to bug in excel which considers 1900 as a Leap Year though it was not a leap year.

This is why I will recommend to use second Formula in excel to determine a Leap Year since it takes care of any bug that exists in excel

VBA Function for Leap Year Test:

Public Function IsLeapYear(ByVal YY As Long) As Boolean
    IsLeapYear = Day(DateSerial(YY, 3, 0)) = 29
End Function

Leap Year , leap year test , leap year check , check leap year , Leap Year in Excel

Excel Convert Text to Date

Many of us get into a situation when the dates in our data are coded as text. Excel does not recognise such text entries as date and we can not use them for any calculation purpose. However you can easily covert them to date by the help of excel formula.

You may have a situation where the text of the date is actually as date but being a text string it is not recognised as date by excel. It could be 12/Oct/2009 in text string. You can easily convert them using Datevalue formula. Assuming you have text in cell A2, the formula you need to enter is =DATEVALUE(A2)

However many time we get data stored like 20091012. Here October 12, 2009 has been stored as First 4 digits as Year, next 2 Digits as Month, next 2 Digits as Day. It becomes little tricky but it can also be converted to date using combination of Mid and Date function of excel.

Assuming you have date stored as 20091012 in cell A3 of you worksheet, you can convert it to date using =DATE(MID(A3,1,4),MID(A3,5,2),MID(A3,7,2))

Logic behind this formula is devide the text into Year , Month and Day separatly. This is done by using MID function of excel. Once you are able to break text string into three different components of Date. You put these in the Date Function of Excel. Syntex for Excel Date function is DATE(year, month, day).

MID(A3,1,4) = 2009 - This Year Value in Text String
MID(A3,5,2) = 10 - This is Month Value in Text String
MID(A3,7,2) = 12 - This is Day Value in Text String

This is converted into Grand Formula = DATE(MID(A3,1,4),MID(A3,5,2),MID(A3,7,2))

If you see the formula I have just brokenup the text string using MID in combination with Date function.

See picture below to understand it better.

convert text to date in excel , excel convert text to date, convert text to date, date values

Excel Macros : Log User Activity to Log Sheet

We all store Excel workbooks on shared drives. While those files are accessed by many users but there is no track about who did what at various points of time. However this problem can be resolved with the help of VBA. A VBA programme with following capability can help us to get the log of user activity.

 
     1. Add sheet named Log in case it is does not exist in the file.
     2. Record user activity based on events to Log sheet.
     3. Along with recording a event, it records user information and time of event.
     4. Manage log size and removes old entries while creating space for new entries.
     5. User can view the log but can not make changes to the log.

Following code has all these capabilities. Macro given below records user activity based on event information passed to it by another macro. You will need to copy this code to regular VBA module of your workbook

Sub Elog(Evnt As String) '*************************************************************************************************** '* Macro recorded by Yogesh Gupta, smiley123z@gmail.com, Ygblogs.blogspot.com on September 27, 2009 * '*************************************************************************************************** Application.ScreenUpdating = False Dim cRecord As Long cSheet = ActiveSheet.Name If SheetExists("Log") = False Then Sheets.Add.Name = "Log" Sheets("Log").Select ActiveSheet.Protect "Pswd", UserInterfaceOnly:=True End If Sheets("Log").Visible = True Sheets("Log").Select ActiveSheet.Protect "Pswd", UserInterfaceOnly:=True cRecord = Range("A1") If cRecord <= 2 Then cRecord = 3 Range("A2").Value = "Event" Range("B2").Value = "User Name" Range("C2").Value = "Domain" Range("D2").Value = "Computer" Range("E2").Value = "Date and Time" End If If Len(Evnt) < 25 Then Evnt = Application.Rept(" ", 25 - Len(Evnt)) & Evnt Range("A" & cRecord).Value = Evnt Range("B" & cRecord).Value = Environ("UserName") Range("C" & cRecord).Value = Environ("USERDOMAIN") Range("D" & cRecord).Value = Environ("COMPUTERNAME") Range("E" & cRecord).Value = Now() cRecord = cRecord + 1 If cRecord > 20002 Then Range("A3:A5002").Select dRows = Selection.Rows.Count Selection.EntireRow.Delete cRecord = cRecord - dRows End If Range("A1") = cRecord Columns.AutoFit Sheets(cSheet).Select Sheets("Log").Visible = xlVeryHidden Application.ScreenUpdating = True End Sub Function SheetExists(SheetName As String) As Boolean On Error GoTo SheetDoesnotExit If Len(Sheets(SheetName).Name) > 0 Then SheetExists = True Exit Function End If SheetDoesnotExit: SheetExists = False End Function Sub ViewLog() Sheets("Log").Visible = True Sheets("Log").Select End Sub Sub HideLog() Sheets("Log").Visible = xlVeryHidden End Sub

Following macros record events like

"Open" , "Save" and "Print"

and pass on the information to above macro to record user activity.

You will need to copy this code to worksheet module of your workbook

Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim Evnt As String Evnt = "Print" Call Elog(Evnt) End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Evnt As String Evnt = "Save" Call Elog(Evnt) End Sub Private Sub Workbook_Open() Dim Evnt As String Evnt = "Open" Call Elog(Evnt) End Sub

Since this code will record user activity only in case macros are enabled, do not forget to force users to enable macros while useing the particular file.

Download file having these macros to record user activity to a log sheet. Check how it works

record user activity , track user activity, logging user activity, log user activity , monitor user activity

Excel Macros : Check Mark Symbols with Double Click

I am sharing with you very interesting trick to insert check mark symbols / to change check mark symbols with the double click in excel.

We can use Wingding font check boxes and change them with the double click with the help of macro

You can add as many of them by just defining the range in your macro. Values can be changed by just a double click.

You will further need to do data validation for that range so that user does not enter any other value by mistake.

You will need to copy this code to worksheet module of your workbook

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) '************************************************************************************************************************* '* Macro recorded by Yogesh Gupta, smiley123z@gmail.com, Ygblogs.blogspot.com on September 16, 2009 * '************************************************************************************************************************* If Not Intersect(Target, Range("G4:G14")) Is Nothing Then ' You can Change the range here Cancel = True With Target .Font.Name = "Wingdings" .Font.Size = 20 .HorizontalAlignment = xlCenter End With If Target.Value = "þ" Then Target.Value = "ý" Else Target.Value = "þ" End If End If End Sub

Download file having trick to insert /change wingdings check mark symbols with double click

Make sure that you have enabled macros before using this file.

This trick can be used to choose any values you want change with the double click and is not limited only to check boxes in wingdings. See the attached file for Yes/No as another example.

Symbol Check Mark , Symbols Check Mark , Type Check Mark , Wingding Font Check Mark , Wingding Check Mark , Wingdings Check Mark , Check Mark Symbol , Check Mark Symbols , Check Symbol , Change values with double click in excel

Excel Macro : File open VBA

Before opening a excel file using VBA, you need to test particular file is open or not in excel. This is required as it can result into a error if particular file is already open.

You need to go step by step to open the file 
    1. Check if excel file is open 
    2. Open that file using VBA , This should be done only in case you know the full path for the particular file 
    3. In case you do not know the full path , it is advisable to give excel file open dialog and let user open the file.

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

Sub Open_File_after_IsOpen_or_Not() '************************************************************************************************************* '* Macro recorded by Yogesh Gupta, smiley123z@gmail.com, Ygblogs.blogspot.com on September 16, 2009 * '* Macro modified on September 19, 2009 based on inputs from Mr. Augusto as per comment left by him * '* Mr. Augusto added FileExist function though his comment and included in this Updated Macro by Yogesh Gupta* '************************************************************************************************************* Dim Myworkbook As String Myworkbook = "FileName.xls" ' Replace the workbook name here If Isopen(Myworkbook) = "Not Open" Then ' In case workbook is not open If FileExist(Myworkbook) = True Then ' In case workbook exist Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Myworkbook Else Call Open_new_file ' let user choose and open the file End If Else Application.Workbooks(Myworkbook).Activate End If End Sub Sub Open_new_file() NewWorkbook = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file") If NewWorkbook = False Then Exit Sub Else Workbooks.Open Filename:=NewWorkbook End If End Sub Public Function Isopen(Myworkbook As String) On Error Resume Next Set wBook = Workbooks(Myworkbook) If wBook Is Nothing Then Isopen = "Not Open" Exit Function End If End Function Public Function FileExist(Myworkbook As String) As Boolean Dim nfile On Error GoTo FileExist_err nfile = FreeFile Open Myworkbook For Input As nfile Close nfile FileExist = True Exit Function FileExist_err: FileExist = False End Function

Download file having File open Macro with test if particular workbook is open or not

File open VBA , VBA open files , File Open Macro , Excel File open VBA , VBA Excel Workbook Open , VBA Excel Open Workbook , VBA open Workbook , Test particular file is open or not in excel , Check if file is open - Excel

Excel Macros : Remove Duplicates Excel

Excel 2007 has built in command to remove duplicates, however earlier versions of excel does not have built in command. You need to use VBA routine to do the job.

Use following code to Identify duplicate values in a column and Remove Rows having Duplicate Values

After identifying the duplicate values system will give you warning and ask for confirmation to delete the entire row(s) having duplicate values. You can choose No in case you do not want to delete them.

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

Sub Find_RemoveDuplicates() '**************************************************************************************************** '* Macro recorded by Yogesh Gupta, smiley123z@gmail.com, Ygblogs.blogspot.com on September 9, 2009 * '* Macro Modified on September 13, 2009 for not deleting empty cells within duplicate values column * '**************************************************************************************************** Dim cRow As Long Dim lRow As Long Dim sCell As Range Dim D As Long lRow = GetLastRowWithData On Error Resume Next Set sCell = Application.InputBox(Prompt:= _ "Select Starting Row of Column with Duplicate values.", _ Title:="Select Column", Type:=8) On Error GoTo 0 If sCell Is Nothing Then Exit Sub End If sCell.Select If Selection.Cells.Count > 1 Then MsgBox ("Pls select Single Cell only") Exit Sub Else dCol = ActiveCell.Column sRow = ActiveCell.Row For cRow = lRow To sRow Step -1 If IsEmpty(Cells(cRow, dCol)) = False Then If WorksheetFunction.CountIf(Range(sCell, Cells(cRow, dCol)), Cells(cRow, dCol).Text) > 1 Then Cells(cRow, dCol).Interior.Color = 255 'This Marks the duplicate values as Red D = D + 1 End If End If Next cRow If D = 0 Then MsgBox ("No Duplicate Values Found") Else caution = MsgBox(D & " Duplicate entries selected and marked RED" & vbCrLf & _ "Do you want to delete them? " & vbCrLf & _ "Entire Row for the marked entries will be deleted. " & vbCrLf & _ "Do you want to Continue?", vbYesNo, "Confirmation") If caution = vbYes Then For cRow = lRow To sRow Step -1 If IsEmpty(Cells(cRow, dCol)) = False Then If WorksheetFunction.CountIf(Range(sCell, Cells(cRow, dCol)), Cells(cRow, dCol).Text) > 1 Then Cells(cRow, dCol).EntireRow.Delete ' This deletes the entire row End If End If Next cRow End If End If End If End Sub '******************************************************************** '* UDF to Get Last Row with Data on worksheet * '******************************************************************** Public Function GetLastRowWithData() As Long Dim ExcelLastCell As Object, lRow As Long, lLastDataRow As Long, l As Long Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) lLastDataRow = ExcelLastCell.Row lRow = ExcelLastCell.Row Do While Application.CountA(ActiveSheet.Rows(lRow)) = 0 And lRow <> 1 lRow = lRow - 1 Loop lLastDataRow = lRow GetLastRowWithData = lLastDataRow End Function

Download file having Macro to Find and Remove Duplicates in Excel.

Above works well in case you are trying to clean a data table on the sheet, however if you have lots of other data also on the sheet, you should try the Find and Remove duplicates within Range



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

Sub Find_RemoveDuplicatesWithinRange() '*************************************************************************************************** '* Macro recorded by Yogesh Gupta, smiley123z@gmail.com, Ygblogs.blogspot.com on September 13, 2009 * '*************************************************************************************************** Dim cRow As Long Dim sRow As Long Dim lRow As Long Dim sCol As Long Dim lCol As Long Dim dColumn As Long Dim D As Long Dim sCell As Range Dim dRange As Range On Error Resume Next Set dRange = Application.InputBox(Prompt:= _ "Select Data Range with Duplicate values.", _ Default:=Selection.Address, Title:="Select Range", Type:=8) If dRange Is Nothing Then Exit Sub End If With dRange sRow = Cells(.Row, .Column).Row sCol = Cells(.Row, .Column).Column lCol = Cells(.Row, .Column + .Columns.Count - 1).Column lRow = Cells(.Row + .Rows.Count - 1, .Column + .Columns.Count - 1).Row End With dColumn = 0 Do While dColumn = 0 Set sCell = Application.InputBox(Prompt:= _ "Select Column with Duplicate values.", _ Title:="Select Column", Type:=8) On Error GoTo 0 If sCell Is Nothing Then Exit Sub End If If sCell.Columns.Count > 1 Then MsgBox ("Pls select Single Column only") Else dCol = sCell.Column If dCol < sCol Then MsgBox ("Select Column within earlier Range") ElseIf dCol > lCol Then MsgBox ("Select Column within earlier Range") Else dColumn = 1 End If End If Loop For cRow = lRow To sRow Step -1 If IsEmpty(Cells(cRow, dCol)) = False Then If WorksheetFunction.CountIf(Range(Cells(sRow, dCol), Cells(cRow, dCol)), Cells(cRow, dCol).Text) > 1 Then Range(Cells(cRow, sCol), Cells(cRow, lCol)).Select Selection.Interior.Color = 255 D = D + 1 End If End If Next cRow Cells(sRow, sCol).Select If D = 0 Then MsgBox ("No Duplicate Values Found") Else caution = MsgBox(D & " Duplicate entries selected and marked RED" & vbCrLf & _ "Do you want to delete them? " & vbCrLf & _ "Marked entries will be deleted and data will move up " & vbCrLf & _ "Do you want to Continue?", vbYesNo, "Confirmation") If caution = vbYes Then For cRow = lRow To sRow Step -1 If IsEmpty(Cells(cRow, dCol)) = False Then If WorksheetFunction.CountIf(Range(Cells(sRow, dCol), Cells(cRow, dCol)), Cells(cRow, dCol).Text) > 1 Then Range(Cells(cRow, sCol), Cells(cRow, lCol)).Select Selection.Delete Shift:=xlUp End If End If Next cRow Cells(sRow, sCol).Select End If End If End Sub

Download file having macro to find and remove duplicates within a range

Delete Duplicates , Delete Duplicate , Remove Duplicates , Remove Duplicate , Find Duplicates , Find Duplicate , Excel Delete Duplicates , Remove Duplicates Excel , Remove Duplicate Excel

Excel Macros : Find Last Row

Many times we need to find out the last row of excel sheet which is used by data. This has many uses such as to

Add new column to the data only up to the last used row of exiting dateAdd new row to the data immediately after the last row so as you do not over write the exiting data.

See the code below for the doing the activities as listed above.

Sub LastRowOfData() '*************************************************************************************************** '* Macro recorded by Yogesh Gupta, smiley123z@gmail.com, Ygblogs.blogspot.com on September 4, 2009 * '*************************************************************************************************** If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False End If LastRow = GetLastRowWithData ' Getting the Row number Range("C3").Select ' Select the header row of the data in new column ActiveCell.FormulaR1C1 = "Col 2" ' Add new column header Range("C4").Select ' Select the starting column where you need to add data ActiveCell.FormulaR1C1 = "XYZ" ' Add Data Value or Formula Range("C4:C" & LastRow).Select ' This will select the column from starting row to Last row of data Selection.FillDown ' This will fill the data downwards from First row i.e. Formula or value added by you Range("B" & LastRow + 1).Select ' This selects the starting cell of row next to last row of exiting data End Sub '******************************************************************** '* UDF to Get Last Row with Data on worksheet * '******************************************************************** Public Function GetLastRowWithData() As Long Dim ExcelLastCell As Object, lRow As Long, lLastDataRow As Long, l As Long Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) lLastDataRow = ExcelLastCell.Row lRow = ExcelLastCell.Row ' Do While Application.CountA(ActiveSheet.Rows(lRow)) = 0 And lRow <> 1 lRow = lRow - 1 Loop ' lLastDataRow = lRow GetLastRowWithData = lLastDataRow End Function

Function GetLastRowWithData gives inaccurate results if you have active filters on the worksheet. That is why I have included code to remove active filters from the worksheet before using this function to get last row of data.

Download sample file to check how it works.

There is one more option which gives you satisfactory results

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Take care to remove filters before using above code

There are some more options to find last row however are not very reliable as they give you last row of the worksheet irrespective of fact that row could be a empty row.

LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
or
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

Select Last Row , Find Last Row , VBA Last Row , VBA Find Last Row , Excel Last Row

Hardware Locking for excel workbook with VBA

Many time we desire that our workbook is locked to work with a particular machine. This can be achieved through Hardware Locking of your workbook using VBA. Some of the avaiable solutions will require you to buy external harware dongles and will cost you good amount of money.

However if you can lock your workbook with the existing hardware of the machine , you will not need external hardware dongles.

if you use following Excel function to get Mother Board Serial Number, you can compare the current machines mother board serial number with the desired one. If you know that the desired serial number does not match with current machine you know that there is security voilation and you can close the workbook through VBA. You will need to copy this code to regular VBA module of your workbook

Excel Function to Get Mother Board Serial Number

Public Function MBSerialNumber() As String
Dim objs As Object                                                                                                                     
Dim obj As Object
Dim WMI As Object
Dim sAns As String
Set WMI = GetObject("WinMgmts:")
Set objs = WMI.InstancesOf("Win32_BaseBoard")
For Each obj In objs
    sAns = sAns & obj.SerialNumber
    If sAns < objs.Count Then sAns = sAns & ","
Next
MBSerialNumber = sAns

End Function

After you have placed above function in VBA module. You will need to copy this code to ThisWorkbook section of your workbook . This is autoopen macro which compares the MBSerialNumber of current machine with the desired MBSerialNumber. In case it does not mactch, it will close activeworkbook.

Private Sub Workbook_Open()
    Set RMBSN = Sheets(1).Range("C4") ' This is whare you have already stored required MBSerialNumber
    If MBSerialNumber <> RMBSN Then   ' Checking if current machine serial number is matching with required
        MsgBox ("Data Security failier, This workbook will close") ' In case it does not match workbook will be closed
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    End If
End Sub

Download Excel file with macro for Hardware Locking for Excel Workbooks

and try to open it on your machine and see how it works. This is locked version and you will not be able to open it on your machine.

However you can down load Unlocked version of Hardware Locking for Excel Workbooks.

Excel Macros : VBA Expiry date for Excel Workbook

Many times we have a situation where we need to force users to use updated file and stop using the old version of worksheet. The only way to do so is to put expiry date for your workbook. User will not be able to work upon the file once the expiry date is crossed and will be forced to look for updated version.

You will need to copy this code to ThisWorkbook section of your workbook .

Private Sub Workbook_Open()
    Dim Edate As Date
    Edate = Format("31/08/2009", "DD/MM/YYYY") ' Replace this with the date you want
    If Date > Edate Then
        MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed")
        ActiveWorkbook.Close
    End If
    If Edate - Date < 30 Then
    MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left ")
    End If
End Sub

Once the expiry date is crossed, user will get message and workbook will be closed by macro
Once the expiry date in with next thirty days, user will get warning message about expiry date and number of days left.

Download file containing Workbook Expiry Date Macro

Excel Functions : Convert Numbers into Words

Many times we need the amount in figures to be converted into words. This is a typical requirement for writing checks or any other financial reports. Microsoft Excel does not have standard function available for this requirement. However there are customised functions available on the Internet. One such solution is available at Allexperts.com.

Display Numbers to Text.

You need to copy this to your regular macro module. Once you have added it to your file you can use function SpellNumbers to convert any number into words easily as you use any other function of excel.

Function available at the net covers USD as currency, whereas I needed it in Indian Rupees. I have modified this to give results in any currency. The revised version gives me results as shown in the screen cast below.

Download excel file having this user defined function to convert numbers to words

Make sure that you enable macros to use this function. In case macros are disabled this function will not work in downloaded file

Syntex for the modified UDF is :-
SpellCurr(MyNumber, MyCurrency, MyCurrencyPlace, MyCurrencyDecimals, MyCurrencyDecimalsPlace)

where
MyNumber = Numeric Value you need to convert into words
MyCurrency = Name of your Currency - i.e. Dollar for USA
MyCurrencyPlace = Prefix or Suffix the currency, use "P" for Prefix and "S" for Suffix
MyCurrencyDecimals = Name of your Currency Decimals - i.e. Cent for USA
MyCurrencyDecimalsPlace = Prefix or Suffix the currency decimals, use "P" for Prefix and "S" for Suffix

Modified code given below for those who want to use it. Currency inputs are optional and you will not need to input currency details in case you are using it for Indian Currency. Still this can be used for any currency provided you give currency inputs.

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

Function SpellCurr(ByVal MyNumber, _ Optional MyCurrency As String = "Rupee", _ Optional MyCurrencyPlace As String = "P", _ Optional MyCurrencyDecimals As String = "Paisa", _ Optional MyCurrencyDecimalsPlace As String = "S") '***************************************************************************************************************** '* Based on SpellNumbers UDF by Microsoft, Which handles only Dollars as currency * '* UDF modfied by Yogesh Gupta, smiley123z@gmail.com, Ygblogs.blogspot.com on July 21, 2009 * '* UDF modified on September 04, 2009 to make currency inputs optional, by default it will use Indian Currency * '* This modified UDF can be used for any currency in case you provide for currency inputs * '* User can define the Prefix and Sufix place for Currency and CurrencyDecimals * '* MyNumber = Numeric Value you need to convert into words * '* MyCurrency = Name of your Currency - i.e. Dollar for USA * '* MyCurrencyPlace = Prefix or Suffix the currency, use "P" for Prefix and "S" for Suffix * '* MyCurrencyDecimals = Name of your Currency Decimals - i.e. Cent for USA * '* MyCurrencyDecimalsPlace = Prefix or Suffix the currency decimals, use "P" for Prefix and "S" for Suffix * '***************************************************************************************************************** Dim Rupees, Paisa, Temp Dim DecimalPlace, Count ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " 'String representation of amount. MyNumber = Trim(Str(MyNumber)) 'Position of decimal place 0 if none. DecimalPlace = InStr(MyNumber, ".") ' Convert Paisa and set MyNumber to Rupee amount. If DecimalPlace > 0 Then Paisa = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2)) MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp = GetHundreds(Right(MyNumber, 3)) If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees If Len(MyNumber) > 3 Then MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop If MyCurrencyPlace = "P" Then Select Case Rupees Case "" Rupees = MyCurrency & "s" & " Zero" Case "One" Rupees = MyCurrency & " One" Case Else Rupees = MyCurrency & "s " & Rupees End Select Else Select Case Rupees Case "" Rupees = "Zero " & MyCurrency & "s" Case "One" Rupees = "One " & MyCurrency Case Else Rupees = Rupees & " " & MyCurrency & "s" End Select End If If MyCurrencyDecimalsPlace = "S" Then Select Case Paisa Case "" Paisa = " Only" Case "One" Paisa = " and One " & MyCurrencyDecimals & " Only" Case Else Paisa = " and " & Paisa & " " & MyCurrencyDecimals & "s Only" End Select Else Select Case Paisa Case "" Paisa = " Only" Case "One" Paisa = " and " & MyCurrencyDecimals & " One " & " Only" Case Else Paisa = " and " & MyCurrencyDecimals & "s " & Paisa & " Only" End Select End If SpellCurr = Rupees & Paisa End Function '******************************************* ' Converts a number from 100-999 into text * '******************************************* Function GetHundreds(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) ' Convert the hundreds place. If Mid(MyNumber, 1, 1) <> "0" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred " End If ' Convert the tens and ones place. If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & GetTens(Mid(MyNumber, 2)) Else Result = Result & GetDigit(Mid(MyNumber, 3)) End If GetHundreds = Result End Function '********************************************* ' Converts a number from 10 to 99 into text. * '********************************************* Function GetTens(TensText) Dim Result As String Result = "" ' Null out the temporary function value. If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19... Select Case Val(TensText) Case 10: Result = "Ten" Case 11: Result = "Eleven" Case 12: Result = "Twelve" Case 13: Result = "Thirteen" Case 14: Result = "Fourteen" Case 15: Result = "Fifteen" Case 16: Result = "Sixteen" Case 17: Result = "Seventeen" Case 18: Result = "Eighteen" Case 19: Result = "Nineteen" Case Else End Select Else ' If value between 20-99... Select Case Val(Left(TensText, 1)) Case 2: Result = "Twenty " Case 3: Result = "Thirty " Case 4: Result = "Forty " Case 5: Result = "Fifty " Case 6: Result = "Sixty " Case 7: Result = "Seventy " Case 8: Result = "Eighty " Case 9: Result = "Ninety " Case Else End Select Result = Result & GetDigit _ (Right(TensText, 1)) ' Retrieve ones place. End If GetTens = Result End Function '******************************************* ' Converts a number from 1 to 9 into text. * '******************************************* Function GetDigit(Digit) Select Case Val(Digit) Case 1: GetDigit = "One" Case 2: GetDigit = "Two" Case 3: GetDigit = "Three" Case 4: GetDigit = "Four" Case 5: GetDigit = "Five" Case 6: GetDigit = "Six" Case 7: GetDigit = "Seven" Case 8: GetDigit = "Eight" Case 9: GetDigit = "Nine" Case Else: GetDigit = "" End Select End Function

Spell Currency Excel Addin avilable now

Numbers to Words , Convert Number to Words , Convert Number to Word , Number to Words , Number to Word , Number to Text , Number in Words , Number to Letters , Convert Number to Text , VBA Number to Text , Number to Text Function , Numeric to Text

Macros in Excel : Selecting Multiple Ranges in Excel VBA

Selecting multiple ranges in Excel VBA helps your code to work faster. You can select multiple ranges in single line code and perform the action you want to perform.

Normally we code a range by writing it within "" as under

Range("A1:A10").Select 

However if you put , between multiple ranges within the same line of the code you can select multiple ranges as given under

Range("A1:A10,D1:D10,F1:F10").Select 

How to use Multiple Ranges in Excel VBA

Following macro code will explain you how to use multiple ranges in Excel VBA

Sub Multiple_ranges()
Range("A1:A10").Select                                                                                                       
MsgBox ("Single Range Selected")
Range("A1:A10,D1:D10,F1:F10").Select
MsgBox ("Multiple Ranges Selected")
Selection.Copy
Range("A11").Select
ActiveSheet.Paste
End Sub 

In the above macro we have selected range three different ranges

A1:A10
D1:D10
F1:F10

After selection we have copied the contents to Range A11. Another option for doing this was to copy the contents one by one for each of the range. However copy and paste is only one of the example you can use this for any desired action by you.

You can combine multiple ranges into one Range object using the Union method.

The following example creates a Range object called myMultipleRange, defines it as the ranges A1:B2 and C3:D4, and then formats the combined ranges as bold.

Sub MultipleRange() Dim r1, r2, myMultipleRange As Range Set r1 = Sheets("Sheet1").Range("A1:B2") Set r2 = Sheets("Sheet1").Range("C3:D4") Set myMultipleRange = Union(r1, r2) myMultipleRange.Font.Bold = True End Sub

Macros in Excel : Forcing Users to Enable Macros

Many times we face issue of disable macros situation while the user is using our project. Since the macros are disabled, there is no way that the macros in your project will work the dessired way. However you can force your users to enable macros while working with your files. Simplest way is to hide the main sheet in your project using xlVeryHidden property in your macro. The workseets hidden by using this method can be made visible only by using VBA. The unhide workseet dialog box does not display the names of sheets hidden by using VBA with xlVeryHidden property.



You need to have one sheet which displays message that macros are disabled and needs to be enabled to use this file. Once the macros are enabled, the message sheets can be hidden and data sheets can be made visible. You can copy the following code to Thisworkbook section of your VBA project.

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
    Sheets("Msg").Visible = True
    Sheets("Data").Visible = xlVeryHidden

End Sub

Private Sub Workbook_Open()

    Sheets("Data").Visible = True
    Sheets("Msg").Visible = xlVeryHidden

End Sub

First macro code makes Msg Sheet visible and hides Data Sheet. This macros runs on even of closing the workbook. Second macro makes Data Sheet Visible and hides Msg Sheet. This macro runs on even of opening of workbook.

You can add following line to first macro to compulsoraly save the workbook before closure. However use this only if you are sure that it is okay to save the file before closing.

   ActiveWorkbook.Save

In case you have multiple sheets and you want to hide all the sheets except the Msg sheet, use following code in ThisWorkbook Module. Make sure that the Msg sheet is first sheet of your workbook. Following code will keep first sheet visible on close and Unhide all other sheets and hide first sheet on open.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim myCount 'This line of code is optional
Dim i 'This line of code is optional
On Error Resume Next
myCount = Application.Sheets.Count

Sheets(1).Visible = True
Range("A1").Select
For i = 2 To myCount
Sheets(i).Visible = xlVeryHidden
If i = myCount Then
End If
Next i
ActiveWorkbook.Save

End Sub

Private Sub Workbook_Open()

Dim myCount 'This line of code is optional
Dim i 'This line of code is optional
On Error Resume Next

myCount = Application.Sheets.Count
For i = 2 To myCount
Sheets(i).Visible = True
If i = myCount Then
Sheets(1).Visible = xlVeryHidden
End If
Next i

End Sub 

Download file with Macro code to Force users to Enable Macros

Code above is simplest way to force normal users to enable macros and make your project file work the way you want them to. However the advanced users can always get into your project by using VBA routine stored in onother file. This can be done by following the steps as given below.

1. Open the project file while the Macros are disabled.
2. Encable the Macros.
3. Unhide the hidden sheets in project file by macros code in another file

There are ways and means to overcome this situation also, but a advanced user will find a way to get into your project if they realy want to. So I feel there is no need to complecate the code for keeping them away. You can always make normal users to use your project file the way you want them to by using simpe code given above

Macros in Excel : Learn Excel VBA : Variables

This is continuation of my earlier posts on

   Macros in Excel : Learn Excel VBA : Objects 
   Macros in Excel : Learn Excel VBA : Methods
   Macros in Excel : Learn Excel VBA : Properties

It is not necessary to declare a variable in VBA, Visual Basic automatically creates storage for a variable on first use in the code. Automatically created variables are of type variant and can contain any type of data. It can be strings, boolean values, object , arrays or numbers.

Simple statement such as given below creates a variable and assigns value to it

 Myvariable = 28 

Similarly you can use different variables in calculation to create another variable for your VBA code. Following code will explain the use of Variables in Excel VBA

Sub Explain_Variables()

Var_A = 10
Range("A4").Select ' Value of Cell A4 is 5
Var_B = ActiveCell

Var_Total = Var_A + Var_B

Range("A5") = Var_Total

End Sub

This code explains that

1. Var_A is declared as constant number in the code itself.
2. Var_B is declared as value in ActiveCell i.e. Cell A4 in this case with Value as number 5.
3. We have used Var_A and Var_B to calculated Var_Total
4. We have used Var_Total to update the value in Cell A5, the result of this code is number 15 in Cell A5

Macros in Excel : Auto Open Macro / Auto Run Macro

Many times we want certain task to be executed when you open a particular file. This can be achieved by auto open macro or auto run macro. This is the macro which executes itself when you open a excel file.

There are two methods to do this

Method 1. Auto open macro in VBA Project Module

In this case you add your macro code to VBA project module and it gets executed when you open the file. When you go to your VBA editor, you select a module as highlighted in the picture and copy following code to have auto run macro.

Private Sub Auto_Open()

MsgBox "This is auto open macro in Module"

End Sub 

Method 2. Auto open macro in ThisWorkbook Section

In this method you add your code to Thisworkbook Section of your excel file. double click on highlighted potion in your VBA editor and paste following code

Private Sub Workbook_Open()

MsgBox "This is auto open macro in This workbook"

End Sub 

You can replace the message box line with your code / action you want your macro to do. I have used this as example to keep my macro code short for better understanding.

Auto open Macro , Excel auto open macro , Auto run macro , Auto open excel , VBA excel workbook open

Macros in Excel : Disable Right Click Menu

Many times we need to disable right click menu in our workbook. We can achieve this by using Marcos in Excel. You need to add the Macro code to This workbook section in your VBA project. When you go to your Visual Basic Editor you can see the ThisWorkbook on the left hand side of your VBA Project.

You need to double click on highlighed portion and copy the following code. Since these macros has Private word before Sub, no one will be able to see this macros from View Macro menu.

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Right click menu deactivated." & vbCrLf & _
"For this file:", 16, ""
End Sub

Macros in Excel : Disable Cut Copy Paste

Many times we need to disable Cut Copy and Paste in our workbook. You can achieve this by using Marcos in Excel. You need to add the Macro code to This workbook section in your VBA project. When you go to your Visual Basic Editor you can see the ThisWorkbook on the left hand side of your VBA Project.

You need to double click on highlighed portion and copy the following code. This code also disables the rightclick menu. Since these macros has Private word before Sub, no one will be able to see these macros from View Macro menu.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
With Application
.CellDragAndDrop = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
.CutCopyMode = False
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) 'copy
    Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
    Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
    Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
    Ctrl.Enabled = True
Next Ctrl

End Sub

Private Sub Workbook_Open()
    On Error Resume Next
    With Application
    .CutCopyMode = False
    .CellDragAndDrop = False
    .OnKey "^c", ""
    .OnKey "^v", ""
    .OnKey "^x", ""
    .OnKey "+{DEL}", ""
    .OnKey "^{INSERT}", ""
    End With
   
    Dim Ctrl As Office.CommandBarControl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
        Ctrl.Enabled = False
    Next Ctrl
    
    End Sub

Private Sub Workbook_Activate()
    On Error Resume Next
    With Application
    .CutCopyMode = False
    .CellDragAndDrop = False
    .OnKey "^c", ""
    .OnKey "^v", ""
    .OnKey "^x", ""
    .OnKey "+{DEL}", ""
    .OnKey "^{INSERT}", ""
    End With
    Dim Ctrl As Office.CommandBarControl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
        Ctrl.Enabled = False
    Next Ctrl
   
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Right click menu deactivated." & vbCrLf & _
"For this file:", 16, ""
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
     Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    
    On Error Resume Next
    With Application
    .CutCopyMode = False
    .CellDragAndDrop = False
    .OnKey "^c", ""
    .OnKey "^v", ""
    .OnKey "^x", ""
    .OnKey "+{DEL}", ""
    .OnKey "^{INSERT}", ""
    End With
    Dim Ctrl As Office.CommandBarControl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
        Ctrl.Enabled = False
    Next Ctrl
    For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
        Ctrl.Enabled = False
    Next Ctrl
    
End Sub
Private Sub Workbook_Deactivate()
On Error Resume Next
With Application
.CellDragAndDrop = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
.CutCopyMode = False
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
    Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
    Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
    Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
    Ctrl.Enabled = True
Next Ctrl

End Sub

Download file having disable cut copy paste Macro

Macros in Excel : Learn Excel VBA : Properties

This in continuation of my earlier post on

   Macros in Excel : Learn Excel VBA : Objects
   Macros in Excel : Learn Excel VBA : Methods

Each VBA object has its own properties that controls its appearance. When we talk about range as object typical properties are

   - ColumnWidth
   - RowHeight
   - Font
   - Text
   - Value
   - Formula
   - Borders

Syntax in your macro is

    Object.Property = Value

or

    Range("A1").RowHeight = 60 

or

    Range("A1").FormulaR1C1 = "=R[2]C+R[3]C" 

Following instruction will set the columon width to 25

    Range("A1").ColumnWidth = 25 

In case property is on left hand side of = sign it is updated with the new value mentioned on the right hand side of = sign

In case you have property on the right hand side of = sign it means you are reading value from that object. Following statement will set the column width of Cell A2 as 35 considering that Cell A1 has column widht of 25

 Range("A2").ColumnWidth = Range("A1").ColumnWidth + 10 

If you are new to Macros in Excel, Please go through my earlier posts on

1. Automating Tasks in Excel : Using Macros in Excel
2. Recording Excel Macros / Writing excel macros (VBA)

Custom Formating - Excel Number Format

Excel stores numbers as normal numbers only, however you can view them as you want based on how do you format the cells.



If you see there are pre defined number format options available when you choose cell format option, however you can use custom format option if available formats does not server your requirement.



There are four sections of format codes. The sections are separated by semicolons ";" First section defines the formats for positive numbers; Second section defines negative numbers; third section defines how to show zero values; and forth one define how to diplay text. If you specify only two sections, the first is used for positive numbers and zeros, and the second is used for negative numbers. If you specify only one section, all numbers use that format. If you want to skip a section, include the ending semicolon for that section.

# displays only significant digits and does not display insignificant zeros.

0 (zero) displays insignificant zeros if a number has fewer digits than there are zeros in the format.

? adds spaces for insignificant zeros on either side of the decimal point so that decimal points align.

? can also be used for fractions that have varying numbers of digits.

Special Symbol Shortcuts Using the ALT Key

There are some special symbols which we need to use many times but they are not available on the keyboard. We can type them using ALT key and numeric code for the particular symbol

Pls see the chart for numeric codes for various symbols. If you need to type £ you need to press ALT key and keep it pressed while typing 0163. Release ALT key once you have typed 0163. Immediately on release of ALT key you will see £ sign appearing on your screen. You can follow the same process for getting other symbols by typing the relevant numeric code.

Macros in Excel : Learn Excel VBA : Methods

This in continution of my earlier post on Macros in Excel : Learn Excel VBA : Objects

Visual Basic is an object oriented language. Objects have methods that perform action on them. In case range is the object you are working upon following methods would perform action on range object

    - Activate
    - Select
    - Cut
    - Copy
    - Clear
    - Delete
    - Paste 

Syntex of many Visual Basis statements is

    Objects.Methods 

Look at the following code to understand the use of methods in VBA

Sub Explain_Methods()
    Range("C4").Copy
    Range("C8").Select
    ActiveSheet.Paste
   
End Sub 

If you are new to Macros in Excel I suggest that you go through earlier posts on Macros
1. Automating Tasks in Excel : Using Macros in Excel
2. Recording Excel Macros / Writing excel macros (VBA)
3. Macros in Excel : Learn Excel VBA : Objects

Macros in Excel : Pivot Table with Dynamic Data Range

One common issue while creating / recording a macro for Pivot table is the data range of Pivot table gets recorded. Next time when you use the same macro data range for the pivot table will be same as it was at the time of recording of macro. If you do not notice this the report created by macro may represent wrong picture. This may be due to increase in the data size.

However there is a way to overcome this problem by using dynamic data range with the help of Excel Offset Function. Before creating the pivot by macro you need to create dynamic data range using offset function.

Then you create a Pivot with the named range.

See the macro code given below for better understanding

Sub Pivot_with_Dynamic_range()
' This creates Dynamic data range named "PvtData"

ActiveWorkbook.Names.Add Name:="PvtData", RefersToR1C1:= _
"=OFFSET('Data'!R2C1,0,0,COUNTA('Data'!C1),COUNTA('Data'!R2))"

' This creates Pivot using Dynamic data range named "PvtData"

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"PvtData").CreatePivotTable TableDestination:="", TableName:="PivotTable1"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").SmallGrid = False

End Sub

The above code handles the major issue of dynamic data range and will create blank pivot table for your data, you need to add the required fields to complete your report. In this data is available at Sheet named "Data" and starting point of the data is Row 2 Column 1 or Cell "A2". You will need to change these references while using the above code in your macro.

Macro Pivot Table , Pivottable VBA , Pivot Table VBA , Pivot Table Macro , Dynamic Pivot Table , Pivot Table Dynamic Range

Macros in Excel : Fill Blank Cells With Data Above

In case you need to fill the blank cells within a range with the data above it , use following macro code. Since this works on pre selected range of data, so make sure that you have selected the required data range before running your macro.

Let us take an example. if you want to fill the blank cells with in range "A2:D10", make sure that you have select this range before running the macro.

Sub Fill_Blank_Cells()
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"

End Sub 

Please also refer to earlier post on "How to fill blank cells in excel data range with cells above it"

Macros in Excel : Find Blank Cells Macro

In case you need to select blank cells within range , use following macro code. Since this works on pre selected range of data, so make sure that you have selected the required data range before running your macro.

Let us take an example. if you want to find blank cells with in "A2:D10", make sure that you have select this range before running the macro.

Sub Find_Blank_Cells()

    Selection.SpecialCells(xlCellTypeBlanks).Select

End Sub

Macros in Excel : Learn Excel VBA : Objects

It is important to understand Visual Basic Grammar to better understand the macros recorded by you. If you are new to Macros in excel I suggest that you go through earlier posts on Macros
1. Automating Tasks in Excel : Using Macros in Excel
2. Recording Excel Macros / Writing excel macros (VBA)


Visual Basic is object oriented language, it means all items in Excel are considered as objects. There are lots of them but following example will help us understand what an Object is.

   - WorkBook
   - WorkSheet
   - Range
   - Chart
   - Legend

In a Macro Range("A1") is an object. An object can contain other objects.
WorkBook is the larger object followed by WorkSheet and Range.

Workbooks("Macros Book.xls").Worksheets("Data").Range("A1")

Code above refers to Cell "A1" on worksheet "Data" in "Macros Book.xls" file. This is long description but can easily be shortened. The worksheet containing the cursor is called Activesheet, similarly workbook containing active sheet is called Activeworkbook

ActiveWorkbook.ActiveSheet.Range("A1")

There is no difference in the previous line and line above in your macro code.

In case you do not refere larger object, Excel Macro will use ActiveWorkBook and ActiveSheet. So if you write Range("A1") it means same if you have your cursor at Worksheet "Data" in "Macros Book.xls" file while running this code.

Table below will explain the use of various objects on Excel VBA

WorkBooks - Referes to all workbooks currently open in Excel
WorkBooks.Item(1) - Referes to first workbook
WorkBooks.(1) - Referes to first workbook
WorkBooks.(Macros Book.xls) - Referes to Macros Book.xls file open

Sheets - Referes to all sheets in workbook both chart sheets and worksheets
Sheets(1) - Referes First sheet on tab bar.
Sheets("Data") - Refer to Sheet called Data

Write Macros in Excel / Clean or Tweak Excel Macro

I am going to cover how to Write excel macro / Clean or tweak recorded excel macro. Those who are not aware about recording excel macro , I suggest them to go through my earlier post on

1. Recording Excel Macro

When you record a macro it records many actions which are actually not required. Pls go through the macro code given below recorded by record macro function of excel.

Sub MergeCells()
    Range("B4:C4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
End Sub

This code is doing three actions

1.Select dells in range B4:C4
2.Merge selected cells i.e. B4:C4
3.Unmerge selected cells i.e. B4:C4

If you see there is lots of unwanted action recorded by macro recorder. Similar action can be achieved by cleaning up the unwanted stuff. See the code given below which performs the same action.

Sub MergeCells_clean()
    Range("B4:C4").Select
    Selection.Merge
    Selection.UnMerge
End Sub

Once you have recorded your macro , you can lookout for unwanted stuff recorded by it. Cleaning up that will help you understand your macro better and you will be able to maintain your macro for long time.

Similar action can be achieved by two line code as under :-

Sub MergeCells_simple()
    Range("B4:C4").Merge
    Range("B4:C4").UnMerge
End Sub

Macros in Excel : Making your macro run every time

A macro records your mouse clicks and keystrokes while you work and lets you play them back later. You can use a macro to record the sequence of commands you use to perform a certain task. When you run the macro, it plays those exact commands back in the same order, causing Excel to behave just as if you had entered the commands yourself.

Certain precautions while recording a macro will help you generate a code which will run every time you are using that macro.

One major issue when you download data from source system for further processing is the sheet name. It is different every time you download data. Since the macro recorded by you will record the sheet name as available at the time of recording of macro. Same macro will not work next time as the sheet name for downloaded data will be different.

To make it work you need to change the sheet name to generic name as first step while recording your macro.

See the code below which is recorded to change the sheet name as first step. This helps to record the same name in macro in the next step when you flip through the sheets.

Sub ChangesheetName()
    Sheets("Sheet1").Name = "Data"
    Sheets("Data").Select
End Sub

Once you have recorded above macro, small tweaking will help you to run this macro every time irrespective of the sheet name in downloaded data. You need to go to Visual Basic Editor and change the recorded macro as under

A small change in the first line of the code will help you run the macro without worrying about the sheet name of downloaded data.

Sub ChangesheetName()
    ActiveSheet.Name = "Data"
    Sheets("Data").Select
End Sub

Recording Excel Macro / Writing Excel Macro (VBA)

A macro records your mouse clicks and keystrokes while you work and lets you play them back later. You can use a macro to record the sequence of commands you use to perform a certain task. When you run the macro, it plays those exact commands back in the same order, causing Excel to behave just as if you had entered the commands yourself.

If you are recording macros for the first time make you "Visual Basic" toolbar visible as it comes handy for recording.

You need to go to "View -> Toolbars -> Visual basic" Once you have made it visible it will look like as seen in picture below:-

Once you have this visible you are ready to record a excel macro.
Click on to start recording.
Once you have clicked , system will prompt with Record Macro dialog box as seen below.

Here the available fields can be changed by user. Macro Name can be any combination of key strokes of your choice. Keep the name you can relate it for job you want your macro to do. Once you click OK button, system is ready to start recording you actions and following toolbar appears on your screen to stop macro recording

Now you perform the task you want you macro to repeat,
Before you record or write a macro, plan the steps and commands you want the macro to perform. If you make a mistake when you record the macro, corrections you make are also recorded. When you record macros, Visual Basic stores each macro in a new module attached to a workbook.

Once you are through with all the steps , you need to stop recording by clicking on . Now your macro has been created by Excel using a programming language called Visual Basic® for Applications (VBA) to record your instructions. You don't have to know anything about programming or VBA to create and use macros.