 Navigation

Home ➜ VBA ➜ 5 Useful Macros

Top 100 Useful Excel Macro [VBA] Codes Examples

Macro codes can save you a ton of time.

You can automate small as well as heavy tasks with VBA codes.

And do you know?

With the help of macros...

...you can break all the limitations of Excel which you think Excel has.

And today, I have listed some of the useful codes examples to help you become more productive
in your day to day work.

You can use these codes even if you haven't used VBA before that.

But here's the first thing to know:

What is a Macro Code?

In Excel, macro code is a programming code which is written in VBA (Visual Basic for

Applications) language.

The idea behind using a macro code is to automate an action which you perform manually in
Excel, otherwise.

For example, you can use a code to print only a particular range of cells just with a single click
instead of selecting the range -> File Tab -> Print -> Print Select -> OK Button.

How to use a Macro Code in Excel

Before you use these codes, make sure you have your developer tab on your Excel ribbon to
access VB editor.

Once you activate developer tab...

...you can use below steps to paste a VBA code into VB editor.

Go to your developer tab and click on "Visual Basic".

On the left side in "Project Window", right click on the name of your workbook and insert a
new module.

Just paste your code into the module and close it.

Now, go to your developer tab and click on the macro button.

It will show you a window with a list of the macros you have in your file from where you can

run a macro from that list.

...a list of top 100 macro codes for VBA beginners

I’ve added all the codes into specific categories so you can find your favorite codes quickly. Just
read the title and click on it to get the code.
Basic

Formatting

Printing

Worksheet

Workbook

Pivot Table

Charts

Advanced

Formulas

Unlock the PDF

Notes

This is my Ultimate VBA Library which I update on monthly basis with new codes. It would be
great if you bookmark this page and keep on visiting t o new codes every time.
To manage all of these codes make sure to read about Personal Macro Workbook to use these

codes in all the workbooks.

I have tested all of these codes in different versions of Excel (2007, 2010, 2013, 2016, and 2019).
If you found any error in any of these codes, make sure to share with me.

Basic Codes
These VBA codes will help you to perform some basic tasks in a flash which you frequently do in
your spreadsheets.

1. Add Serial Numbers

This macro code will help you to automatically add serial numbers in your Excel sheet which can
be helpful for you if you work with large data.
be helpful for you if you work with large data.

Sub AddSerialNumbers()
Dim i As Integer
On Error GoTo Last
i = InputBox("Enter Value", "Enter Serial Numbers")
For i = 1 To i
ActiveCell.Value = i
ActiveCell.Offset(1, 0).Activate
Next i
Last:Exit Sub
End Sub

To use this code you need to select the cell from where you want to start the serial numbers
and when you run this it shows you a message box where you need to enter the highest number

for the serial numbers and click OK.

And once you click OK, it simply runs a loop and add a list of serial numbers to the cells

downward.

2. Insert Multiple Columns

This code helps you to enter multiple columns in a single click. When you run this code it asks
you the number columns you want to add and when you click OK, it adds entered number of
columns after the selected cell.

Sub InsertMultipleColumns()
Dim i As Integer
Dim j As Integer
ActiveCell.EntireColumn.Select
On Error GoTo Last
i = InputBox("Enter number of columns to insert", "Insert Columns")
For j = 1 To i
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightorAbove
Next j
Last: Exit Sub
End Sub

If you want to add columns before the selected cell, replace the xlToRight to xlToLeft in the
code.

3. Insert Multiple Rows

With this code, you can enter multiple rows in the worksheet. When you run this code, you can
enter the number of rows to insert and make sure to select the cell from where you want to
insert the new rows.

Sub InsertMultipleRows()
Dim i As Integer
Dim j As Integer
ActiveCell.EntireRow.Select
On Error GoTo Last
i = InputBox("Enter number of columns to insert", "Insert Columns")
For j = 1 To i
Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove
Next j
Last: Exit Sub
End Sub

If you want to add rows before the selected cell, replace the xlToDown to xlToUp in the code.

4. Auto Fit Columns

This code quickly auto fits all the columns in your worksheet. So when you run this code, it will
select all the cells in your worksheet and instantly auto-fit all the columns.

Sub AutoFitColumns()
Cells.Select
Cells.EntireColumn.AutoFit
End Sub

This code quickly auto fits all the columns in your worksheet. So when you run this code, it will
select all the cells in your worksheet and instantly auto-fit all the columns.

5. Auto Fit Rows

You can use this code to auto-fit all the rows in a worksheet. When you run this code it will
select all the cells in your worksheet and instantly auto-fit all the row.

Sub AutoFitRows()
Cells.Select
Cells.EntireRow.AutoFit
End Sub
6. Remove Text Wrap

This code will help you to remove text wrap from the entire worksheet with a single click. It will

first select all the columns and then remove text wrap and auto fit all the rows and columns.

Sub AutoFitRows()
Cells.Select
Cells.EntireRow.AutoFit
End Sub

There’s also a shortcut that you can use (Alt + H +​W) for but if you add this code to QAT it’s way

more than keyboard shortcut.

7. Unmerge Cells

This code simply uses the unmerge options which you have on the HOME​ tab. The benefit of
using this code is you can add it to the QAT and unmerge all the cell in the selection.

Sub UnmergeCells()
Selection.UnMerge
End Sub

And if you want to un-merge a specific range you can define that range in the code by replacing

the word selection.

8. Open Calculator

In Windows, there is a specific calculator and by using this macro code you can open that
calculator directly from Excel.

Sub OpenCalculator()
Application.ActivateMicrosoftApp Index:=0
End Sub

As I mentioned that it’s for windows and if you run this code in the MAC version of VBA you’ll get
an error.

9. Add Header/Footer Date

This macro adds a date to the header when you run it. It simply uses the tag "&D" for adding the
date. You can also change it to the footer or change the side by replacing the "" with the date
date. You can also change it to the footer or change the side by replacing the "" with the date

tag.

Sub DateInHeader()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&D"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub

And if you want to add a specific date instead of the current date you can replace the "&D" tag

with that date from the code.

10. Custom Header/Footer

When you run this code, it shows an input box that asks you to enter the text which you want to

add as a header, and once you enter it click OK.

Sub CustomHeader()
Dim myText As String
myText = InputBox("Enter your text here", "Enter Text")
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = myText
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub

If you see this closely you have six different lines of code to choose the place for the header or

footer. Let’s say if you want to add left-footer instead of center header simply replace the

“myText” to that line of the code by replacing the "" from there.

Make Sure to Check Out These

 VBA Functions List - Explained with Examples (Listed by

Categories)

VBA

Tutorials

Run a

Macro

Formatting Codes
These VBA codes will help you to format cells and ranges using some specific criteria and
conditions.

11. Highlight Duplicates from Selection

This macro will check each cell of your selection and highlight the duplicate values.

You can also change the color from the code.

Sub HighlightDuplicateValues()

Dim myRange As Range

Dim myCell As Range

Set myRange = Selection

For Each myCell In myRange

If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then

myCell.Interior.ColorIndex = 36

End If

Next myCell

End Sub

12. Highlight the Active Row and Column

I really love to use this macro code whenever I have to analyze a data table.

Here are the quick steps to apply this code.

1. Open VBE (ALT + F11).

2. Go to Project Explorer (Ctrl + R, If hidden).

3. Select your workbook & double click on the name of a particular worksheet in which you want

to activate the macro.

4. Paste the code into it and select the “BeforeDoubleClick” from event drop down menu.
5. Close VBE and you are done.

Remember that, by applying this macro you wi ll not able to edit the cell by double click.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,

Cancel As Boolean)

Dim strRange As String

strRange = Target.Cells.Address & "," Target.Cells.EntireColumn.Address & "," & _

Target.Cells.EntireRow.Address

Range(strRange).Select

End Sub

13. Highlight Top 10 Values

Just select a range and run this macro and it will highlight top 10 values with the green color.

Sub TopTen()

Selection.FormatConditions.AddTop10

Selection.FormatConditions(Selection.FormatConditions.Count).S

tFirstPriority

With Selection.FormatConditions(1)

.TopBottom = xlTop10Top

.Rank = 10

.Percent = False

End With

With Selection.FormatConditions(1).Font

.Color = -16752384

.TintAndShade = 0

End With

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = 13561798

.TintAndShade = 0

End With

Selection.FormatConditions(1).StopIfTrue = False

End Sub

14. Highlight Named Ranges

If you are not sure about how many named ranges you have in your worksheet then you can use
this code to highlight all of them.

Sub HighlightRanges()

Dim RangeName As Name

Dim HighlightRange As Range

On Error Resume Next

For Each RangeName In ActiveWorkbook.Names

Set HighlightRange = RangeName.RefersToRange

HighlightRange.Interior.ColorIndex = 36

Next RangeName

End Sub

15. Highlight Greater than Values

Once you run this code it will ask you for the value from which you want to highlight all greater

values.

Sub HighlightGreaterThanValues()

Dim i As Integer

i = InputBox("Enter Greater Than Value", "Enter Value")

Selection.FormatConditions.Delete

Selection.FormatConditions.Add Type:=xlCellValue,

Operator:=xlGreater, Formula1:=i

Selection.FormatConditions(Selection.FormatConditions.Count).S

tFirstPriority

With Selection.FormatConditions(1)

.Font.Color = RGB(0, 0, 0)

.Interior.Color = RGB(31, 218, 154)

End With

End Sub

16. Highlight Lower Than Values

Once you run this code it will ask you for the value from which you want to highlight all lower
values.

Sub HighlightLowerThanValues()

Dim i As Integer
Dim i As Integer

i = InputBox("Enter Lower Than Value", "Enter Value")

Selection.FormatConditions.Delete

Selection.FormatConditions.Add Type:=xlCellValue,

Operator:=xlLower, Formula1:=i

Selection.FormatConditions(Selection.FormatConditions.Count).S

tFirstPriority

With Selection.FormatConditions(1)

.Font.Color = RGB(0, 0, 0)

.Interior.Color = RGB(217, 83, 79)

End With

End Sub

17. Highlight Negative Numbers

Select a range of cells and run this code. It will check each cell from the range and highlight all
cells the where you have a negative number.

Sub highlightNegativeNumbers()

Dim Rng As Range

For Each Rng In Selection

If WorksheetFunction.IsNumber(Rng) Then

If Rng.Value < 0 Then

Rng.Font.Color= -16776961

End If

End If

Next

End Sub

18. Highlight Specific Text

Suppose you have a large data set and you want to check for a particular value. For this, you can
use this code. When you run it, you will get an input box to enter the value to search for.

Sub highlightValue()

Dim myStr As String

Dim myRg As Range

Dim myTxt As String

Dim myCell As Range

Dim myChar As String

Dim myChar As String

Dim I As Long

Dim J As Long

On Error Resume Next

If ActiveWindow.RangeSelection.Count> 1 Then

myTxt= ActiveWindow.RangeSelection.AddressLocal

Else

myTxt= ActiveSheet.UsedRange.AddressLocal

End If

LInput: Set myRg= Application.InputBox("please select the data

range:", "Selection Required", myTxt, , , , , 8)

If myRg Is Nothing Then

Exit Sub

If myRg.Areas.Count > 1 Then

MsgBox"not support multiple columns" GoToLInput

End If

If myRg.Columns.Count <> 2 Then

MsgBox"the selected range can only contain two columns "

GoTo LInput

End If

For I = 0 To myRg.Rows.Count-1

myStr= myRg.Range("B1").Offset(I, 0).Value

With myRg.Range("A1").Offset(I, 0)

.Font.ColorIndex= 1

For J = 1 To Len(.Text)

Mid(.Text, J, Len(myStr)) = myStrThen

.Characters(J, Len(myStr)).Font.ColorIndex= 3

Next

End With

Next I

End Sub

19. Highlight Cells with Comments

To highlight all the cells with comments use this macro.

Sub highlightCommentCells()

Selection.SpecialCells(xlCellTypeComments).Select

Selection.Style= "Note"
End Sub

20. Highlight Alternate Rows in the Selection

By highlighting alternate rows you can make your data easily readable. And for this, you can use
below VBA code. It will simply highlight every alternate row in selected range.

Sub highlightAlternateRows()

Dim rng As Range

For Each rng In Selection.Rows

If rng.RowMod 2 = 1 Then

rng.Style= "20% -Accent1"

rng.Value= rng^ (1 / 3)

Else

End If

Next rng

End Sub

21. Highlight Cells with Misspelled Words

If you find hard to check all the cells for spelling error then this code is for you. It will check

each cell from the selection and highlight the cell where is a misspelled word.

Sub HighlightMisspelledCells()

Dim rng As Range

For Each rng In ActiveSheet.UsedRange

If Not Application.CheckSpelling(word:=rng.Text) Then

rng.Style= "Bad" End If

Next rng

End Sub

22. Highlight Cells With Error in the Entire Worksheet

To highlight and count all the cells in which you have an error, this code will help you. Just run

this code and it will return a message with the number error cells and highlight all the cells.

Sub highlightErrors()

Dim rng As Range

Dim i As Integer

For Each rng In ActiveSheet.UsedRange

For Each rng In ActiveSheet.UsedRange

If WorksheetFunction.IsError(rng) Then

i = i + 1 rng.Style = "bad"

End If

Next rng

MsgBox "There are total " & i & " error(s) in this worksheet."

End Sub

23. Highlight Cells with a Specific Text in Worksheet

This code will help you to count the cells which have a specific value which you will mention
and after that highlight all those cells.

Sub highlightSpecificValues()

Dim rng As Range

Dim i As Integer

Dim c As Variant

c = InputBox("Enter Value To Highlight")

For Each rng In ActiveSheet.UsedRange

If rng = c Then

rng.Style = "Note"

i = i + 1

End If

Next rng

MsgBox "There are total " & i &" "& c & " in this worksheet."

End Sub

24. Highlight all the Blank Cells Invisible Space

Sometimes there are some cells which are blank but they have a single space and due to this,

it’s really hard to identify them. This code will check all the cell in the worksheet and highlight

all the cells which have a single space.

Sub blankWithSpace()

Dim rng As Range

For Each rng In ActiveSheet.UsedRange

If rng.Value = " " Then

rng.Style = "Note"

End If

Next rng
Next rng

End Sub

25. Highlight Max Value In The Range

It will check all the selected cells and highlight the cell with the maximum value.

Sub highlightMaxValue()

Dim rng As Range

For Each rng In Selection

If rng = WorksheetFunction.Max(Selection) Then

rng.Style = "Good"

End If

Next rng

End Sub

26. Highlight Min Value In The Range

It will check all the selected cells and highlight the cell with the Minimum value.

Sub highlightMinValue()

Dim rng As Range

For Each rng In Selection

If rng = WorksheetFunction.Min(Selection) Then

rng.Style = "Good"

End If

Next rng

End Sub

27. Highlight Unique Values

This codes will highlight all the cells from the selection which has a unique value.

Sub highlightUniqueValues()

Dim rng As Range

Set rng = Selection

rng.FormatConditions.Delete

Dim uv As UniqueValues

Set uv = rng.FormatConditions.AddUniqueValues

uv.DupeUnique = xlUnique
uv.Interior.Color = vbGreen

End Sub

28. Highlight Difference in Columns

Using this code you can highlight the difference between two columns (corresponding cells).

Sub columnDifference()

Range("H7:H8,I7:I8").Select

Selection.ColumnDifferences(ActiveCell).Select

Selection.Style= "Bad"

End Sub

29. Highlight Difference in Rows

And by using this code you can highlight difference between two row (corresponding cells).

Sub rowDifference()

Range("H7:H8,I7:I8").Select

Selection.RowDifferences(ActiveCell).Select

Selection.Style= "Bad"

End Sub

Printing Codes
These macro codes will help you to automate some printing tasks which can further save you a

ton of time.

30. Print Comments

Use this macro to activate settings to print cell comments in the end of the page. Let’s say you

have 10 pages to print, after using this code you will get all the comments on 11th last page.

Sub printComments()

With ActiveSheet.PageSetup

.printComments= xlPrintSheetEnd

End With

End Sub

31. Print Narrow Margin

31. Print Narrow Margin

Use this VBA code to take a print with a narrow margin. When you run this macro it will

automatically change margins to narrow.

Sub printNarrowMargin()

With ActiveSheet.PageSetup

.LeftMargin= Application

.InchesToPoints(0.25)

.RightMargin= Application.InchesToPoints(0.25)

.TopMargin= Application.InchesToPoints(0.75)

.BottomMargin= Application.InchesToPoints(0.75)

.HeaderMargin= Application.InchesToPoints(0.3)

.FooterMargin= Application.InchesToPoints(0.3)

End With

ActiveWindow.SelectedSheets.PrintOutCopies:=1, Collate:=True,

IgnorePrintAreas:=False

End Sub

32. Print Selection

This code will help you print selected range. You don't need to go to printing options and set

printing range. Just select a range and run this code.

Sub printSelection()

Selection.PrintOutCopies:=1, Collate:=True

End Sub

33. Print Custom Pages

Instead of using the setting from print options you can use this code to print custom page

range.

Let’s say you want to print pages from 5 to 10. You just need to run this VBA code and enter

start page and end page.

Sub printCustomSelection()

Dim startpageAs Integer

Dim endpageAs Integer

startpage= InputBox("Please Enter Start Page number.", "Enter Value")

If Not WorksheetFunction.IsNumber(startpage) Then

MsgBox"Invalid Start Page number. Please try again.", "Error"

Exit Sub

End If

endpage= InputBox("Please Enter End Page number.", "Enter Value")

If Not WorksheetFunction.IsNumber(endpage) Then

MsgBox"Invalid End Page number. Please try again.", "Error"

Exit Sub

End If

Selection.PrintOutFrom:=startpage, To:=endpage, Copies:=1

Collate:=True

End Sub

Worksheet Codes
These macro codes will help you to control and manage worksheets in an easy way and save

your a lot of time.

34. Hide all but the Active Worksheet

Now, let's say if you want to hide all the worksheets in your workbook other than the active

worksheet. This macro code will do this for you.

Sub HideWorksheet()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> ThisWorkbook.ActiveSheet.Name Then

ws.Visible = xlSheetHidden

End If

Next ws

End Sub

35. Unhide all Hidden Worksheets

And if you want to un-hide all the worksheets which you have hide with previous code, here is
the code for that.

Sub UnhideAllWorksheet()

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

ws.Visible = xlSheetVisible

Next ws

End Sub

36. Delete all but the Active Worksheet

If you want to delete all the worksheets other than the active sheet, this macro is useful for
you.

When you run this macro it will compare the name of the active worksheet with other

worksheets and then delete them.

Sub DeleteWorksheets()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.name <> ThisWorkbook.ActiveSheet.name Then

Application.DisplayAlerts = False

ws.Delete

Application.DisplayAlerts = True

End If

Next ws

End Sub

37. Protect all Worksheets Instantly

If you want to protect your all worksheets in one go here is a code for you.

When you run this macro, you will get an input box to enter a password. Once you enter your

password, click OK. And make sure to take care about CAPS.

Sub ProtectAllWorskeets()

Dim ws As Worksheet

Dim ps As String

ps = InputBox("Enter a Password.", vbOKCancel)

For Each ws In ActiveWorkbook.Worksheets

ws.Protect Password:=ps

Next ws

End Sub
38. Resize All Charts in a Worksheet

Make all chart same in size. This macro code will help you to make all the charts of the same

size. You can change the height and width of charts by changing it in macro code.

Sub Resize_Charts()

Dim i As Integer

For i = 1 To ActiveSheet.ChartObjects.Count

With ActiveSheet.ChartObjects(i)

.Width = 300

.Height = 200

End With

Next i

End Sub

39. Insert Multiple Worksheets

You can use this code if you want to add multiple worksheets in your workbook in a single shot.

When you run this macro code you will get an input box to enter the total number of sheets you
want to enter.

Sub InsertMultipleSheets()

Dim i As Integer

i = InputBox("Enter number of sheets to insert.", "Enter

Multiple Sheets")

Sheets.Add After:=ActiveSheet, Count:=i

End Sub

40. Protect Worksheet

If you want to protect your worksheet you can use this macro code.

All you have to do just mention your password in the code.

Sub ProtectWS()

ActiveSheet.Protect "mypassword", True, True

End Sub

41. Un-Protect Worksheet

41. Un-Protect Worksheet

If you want to unprotect your worksheet you can use this macro code.

All you have to do just mention your password which you have used while protecting your

worksheet.

Sub UnprotectWS()

ActiveSheet.Unprotect "mypassword"

End Sub

42. Sort Worksheets

This code will help you to sort worksheets in your workbook according to their name.

Sub SortWorksheets()

Dim i As Integer

Dim j As Integer

Dim iAnswer As VbMsgBoxResult

iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _

& "Clicking No will sort in Descending Order", _

vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")

For i = 1 To Sheets.Count

For j = 1 To Sheets.Count - 1

If iAnswer = vbYes Then

If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then

Sheets(j).Move After:=Sheets(j + 1)

End If

ElseIf iAnswer = vbNo Then

If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then Sheets(j).Move After:=Sheets(j + 1)

End If

End If

Next j

Next i

End Sub

43. Protect all the Cells With Formulas

To protect cell with formula with a single click you can use this code.

Sub lockCellsWithFormulas()
Sub lockCellsWithFormulas()

With ActiveSheet

.Unprotect

.Cells.Locked = False

.Cells.SpecialCells(xlCellTypeFormulas).Locked = True

.Protect AllowDeletingRows:=True

End With

End Sub

44. Delete all Blank Worksheets

Run this code and it will check all the worksheets in the active workbook and delete if a

worksheet is blank.

Sub deleteBlankWorksheets()

Dim Ws As Worksheet

On Error Resume Next

Application.ScreenUpdating= False

Application.DisplayAlerts= False

For Each Ws In Application.Worksheets

If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then

Ws.Delete

End If

Next

Application.ScreenUpdating= True

Application.DisplayAlerts= True

End Sub

45. Unhide all Rows and Columns

Instead of unhiding rows and columns on by one manually you can use this code to do this in a

single go.

Sub UnhideRowsColumns()

Columns.EntireColumn.Hidden = False

Rows.EntireRow.Hidden = False

End Sub

46. Save Each Worksheet as a Single PDF

This code will simply save all the worksheets in a separate PDF file. You just need to change the

folder name from the code.

Sub SaveWorkshetAsPDF()

Dimws As Worksheet

For Each ws In Worksheetsws.ExportAsFixedFormat xlTypePDF,

“ENTER-FOLDER-NAME-HERE" & ws.Name & ".pdf" Nextws

End Sub

47. Disable Page Breaks

To disable page breaks use this code. It will simply disable page breaks from all the open

workbooks.

Sub DisablePageBreaks()

Dim wbAs Workbook

Dim wksAs Worksheet

Application.ScreenUpdating= False

For Each wbIn Application.Workbooks

For Each ShtIn wb.WorksheetsSht.DisplayPageBreaks= False

Next Sht

Next wb

Application.ScreenUpdating= True

End Sub

Workbook Codes
These codes will help you to perform workbook level tasks in an easy way and with minimum

efforts.

48. Create a Backup of a Current Workbook

This is one of the most useful macros which can help you to save a backup file of your current

workbook.

It will save a backup file in the same directory where your current file is saved and it will also

add the current date with the name of the file.

Sub FileBackUp()

ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & _

ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & _

"" & Format(Date, "mm-dd-yy") & " " & _

ThisWorkbook.name

End Sub

49. Close all Workbooks at Once

Use this macro code to close all open workbooks.

This macro code will first check all the workbooks one by one and close them. If any of the

worksheets is not saved, you'll get a message to save it.

Sub CloseAllWorkbooks()

Dim wbs As Workbook

For Each wbs In Workbooks

wbs.Close SaveChanges:=True

Next wb

End Sub

50. Copy Active Worksheet into a New Workbook

Let's say if you want to copy your active worksheet in a new workbook, just run this macro code

and it will do the same for you.

It's a super time saver.

Sub CopyWorksheetToNewWorkbook()

ThisWorkbook.ActiveSheet.Copy _

Before:=Workbooks.Add.Worksheets(1)

End Sub

51. Active Workbook in an Email

Use this macro code to quickly send your active workbook in an e-mail.

You can change the subject, email, and body text in code and if you want to send this mail

directly, use ".Send" instead of ".Display".

Sub Send_Mail()

Dim OutApp As Object

Dim OutMail As Object

Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

With OutMail

.to = "[email protected]"

.Subject = "Growth Report"

.Body = "Hello Team, Please find attached Growth Report."

.Attachments.Add ActiveWorkbook.FullName

.display

End With

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

52. Add Workbook to a Mail Attachment

Once you run this macro it will open your default mail client and attached active workbook with

it as an attachment.

Sub OpenWorkbookAsAttachment()

Application.Dialogs(xlDialogSendMail).Show

End Sub

53. Welcome Message

You can use auto_open to perform a task on opening a file and all you have to do just name your

macro "auto_open".

Sub auto_open()

MsgBox "Welcome To ExcelChamps & Thanks for downloading this

file."

End Sub

54. Closing Message

You can use close_open to perform a task on opening a file and all you have to do just name

your macro "close_open".

Sub auto_close()

MsgBox "Bye Bye! Don't forget to check other cool stuff on

excelchamps.com"
excelchamps.com"

End Sub

55. Count Open Unsaved Workbooks

Let’s you have 5-10 open workbooks, you can use this code to get the number of workbooks

which are not saved yet.

Sub VisibleWorkbooks()

Dim book As Workbook

Dim i As Integer

For Each book In Workbooks

If book.Saved = False Then

i = i + 1

End If

Next book

MsgBox i

End Sub

Pivot Table Codes

These codes will help you to manage and make some changes in pivot tables in a flash.

56. Hide Pivot Table Subtotals

If you want to hide all the subtotals, just run this code.

First of all, make sure to select a cell from your pivot table and then run this macro.

Sub HideSubtotals()

Dim pt As PivotTable

Dim pf As PivotField

On Error Resume Next

Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.name)

If pt Is Nothing Then

MsgBox "You must place your cursor inside of a PivotTable."

Exit Sub

End If

For Each pf In pt.PivotFields

pf.Subtotals(1) = True
pf.Subtotals(1) = True

pf.Subtotals(1) = False

Next pf

End Sub

57. Refresh All Pivot Tables

A super quick method to refresh all pivot tables.

Just run this code and all of your pivot tables in your workbook will be refresh in a single shot.

Sub CloseAllWorkbooks()

Dim wbs As Workbook

For Each wbs In Workbooks

wbs.Close SaveChanges:=True

Next wb

End Sub

58. Create a Pivot Table

Follow this step by step guide to create a pivot table using VBA.

59. Auto Update Pivot Table Range

If you are not using Excel tables then you can use this code to update pivot table range.

Sub UpdatePivotTableRange()

Dim Data_Sheet As Worksheet

Dim Pivot_Sheet As Worksheet

Dim StartPoint As Range

Dim DataRange As Range

Dim PivotName As String

Dim NewRange As String

Dim LastCol As Long

Dim lastRow As Long

'Set Pivot Table & Source Worksheet

Set Data_Sheet = ThisWorkbook.Worksheets("PivotTableData3")

Set Pivot_Sheet = ThisWorkbook.Worksheets("Pivot3")

'Enter in Pivot Table Name

PivotName = "PivotTable2"

'Defining Staring Point & Dynamic Range

'Defining Staring Point & Dynamic Range

Data_Sheet.Activate

Set StartPoint = Data_Sheet.Range("A1")

LastCol = StartPoint.End(xlToRight).Column

DownCell = StartPoint.End(xlDown).Row

Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))

NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)

'Change Pivot Table Data Source Range Address

Pivot_Sheet.PivotTables(PivotName). _

ChangePivotCache ActiveWorkbook. _

PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)

'Ensure Pivot Table is Refreshed

Pivot_Sheet.PivotTables(PivotName).RefreshTable

'Complete Message

Pivot_Sheet.Activate

MsgBox "Your Pivot Table is now updated."

End Sub

60. Disable/Enable Get Pivot Data

To disable/enable GetPivotData function you need to use Excel option.

But with this code you can do it in a single click.

Sub activateGetPivotData()

Application.GenerateGetPivotData = True

End Sub

Sub deactivateGetPivotData()

Application.GenerateGetPivotData = False

End Sub

Charts Codes
Use these VBA codes to manage charts in Excel and save your lot of time.

61. Change Chart Type

This code will help you to convert chart type without using chart options from the tab.

All you have to do just specify to which type you want to convert.
Below code will convert selected chart to a clustered column chart.

There are different codes for different types, you can find all those types from here.

Sub ChangeChartType()

ActiveChart.ChartType = xlColumnClustered

End Sub

62. Paste Chart as an Image

This code will help you to convert your chart into an image.

You just need to select your chart and run this code.

Sub ConvertChartToPicture()

ActiveChart.ChartArea.Copy

ActiveSheet.Range("A1").Select

ActiveSheet.Pictures.Paste.Select

End Sub

63. Add Chart Title

First of all, you need to select your chart and the run this code.

You will get an input box to enter chart title.

Sub AddChartTitle()

Dim i As Variant

i = InputBox("Please enter your chart title", "Chart Title")

On Error GoTo Last

ActiveChart.SetElement (msoElementChartTitleAboveChart)

ActiveChart.ChartTitle.Text = i

Last:

Exit Sub

End Sub

Advanced Codes
Some of the codes which you can use to preform advanced task in your spreadsheets.
Some of the codes which you can use to preform advanced task in your spreadsheets.

64. Save Selected Range as a PDF

If you want to hide all the subtotals, just run this code.

First of all, make sure to select a cell from your pivot table and then run this macro.

Sub HideSubtotals()

Dim pt As PivotTable

Dim pf As PivotField

On Error Resume Next

Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.n ame)

If pt Is Nothing Then

MsgBox "You must place your cursor inside of a PivotTable."

Exit Sub

End If

For Each pf In pt.PivotFields

pf.Subtotals(1) = True

pf.Subtotals(1) = False

Next pf

End Sub

65. Create a Table of Content

Let's say you have more than 100 worksheets in your workbook and it's hard to navigate now.

Don't worry this macro code will rescue everything.

When you run this code it will create a new worksheet and create a index of worksheets with a

hyperlink to them.

Sub TableofContent()

Dim i As Long

On Error Resume Next

Application.DisplayAlerts = False

Worksheets("Table of Content").Delete

Application.DisplayAlerts = True

On Error GoTo 0

ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "Table of Content"

For i = 1 To Sheets.Count

With ActiveSheet

.Hyperlinks.Add _

Anchor:=ActiveSheet.Cells(i, 1), _

Address:="", _

SubAddress:="'" & Sheets(i).Name & "'!A1", _

ScreenTip:=Sheets(i).Name, _

TextToDisplay:=Sheets(i).Name

End With

Next i

End Sub

66. Convert Range into an Image

Paste selected range as an image.

You just have to select the range and once you run this code it will automatically insert a picture

for that range.

Sub PasteAsPicture()

Application.CutCopyMode = False

Selection.Copy

ActiveSheet.Pictures.Paste.Select

End Sub

67. Insert a Linked Picture

This VBA code will convert your selected range into a linked picture and you can use that image

anywhere you want.

Sub LinkedPicture()

Selection.Copy

ActiveSheet.Pictures.Paste(Link:=True).Select

End Sub

68. Use Text to Speech

Just select a range and run this code.

Excel will speak all the text what you have in that range, cell by cell.
Excel will speak all the text what you have in that range, cell by cell.

Sub Speak()

Selection.Speak

End Sub

69. Activate Data Entry Form

There is a default data entry form which you can use for data entry.

Sub DataForm()

ActiveSheet.ShowDataForm

End Sub

70. Use Goal Seek

Goal Seek can be super helpful for you to solve complex problems.

Learn more about goal seek from here before you use this code.

Sub GoalSeekVBA()

Dim Target As Long

On Error GoTo Errorhandler

Target = InputBox("Enter the required value", "Enter Value")

Worksheets("Goal_Seek").Activate

With ActiveSheet .Range("C7")

.GoalSeek_ Goal:=Target, _

ChangingCell:=Range("C2")

End With

Exit Sub

Errorhandler: MsgBox("Sorry, value is not valid.")

End Sub

71. VBA Code to Search on Google

Follow this post to learn how to use this VBA code to search on Google.

Sub SearchWindow32()

Dim chromePath As String

Dim search_string As String

Dim query As String

query = InputBox("Enter here your search here", "Google Search")

search_string = query

search_string = Replace(search_string, " ", "+")

'Uncomment the following line for Windows 64 versions and comment out Windows 32 versions'

chromePath = "C:Program

FilesGoogleChromeApplicationchrome.exe"

'Uncomment the following line for Windows 32 versions and comment out Windows 64 versions

chromePath = "C:Program Files

(x86)GoogleChromeApplicationchrome.exe"

Shell (chromePath & " -url http://google.com/#q=" & search_string)

End Sub

Formula Codes
These codes will help you to calculate or get results which often you do with worksheet

functions and formulas.

72. Convert all Formulas into Values

Simply convert formulas into values.

When you run this macro it will quickly change the formulas into absolute values.

Sub ConvertToValues()

Dim MyRange As Range

Dim MyCell As Range

Select Case MsgBox("You Can't Undo This Action. " & "Save

Workbook First?", vbYesNoCancel, "Alert")

Case Is = vbYes

ThisWorkbook.Save

Case Is = vbCancel

Exit Sub

End Select

Set MyRange = Selection

For Each MyCell In MyRange

If MyCell.HasFormula Then

MyCell.Formula = MyCell.Value

End If
End If

Next MyCell

End Sub

73. Remove Spaces from Selected Cells

One of the most useful macros from this list.

It will check your selection and then remove all the extra spaces from that.

Sub RemoveSpaces()

Dim myRange As Range

Dim myCell As Range

Select Case MsgBox("You Can't Undo This Action. " & "Save

Workbook First?", _

vbYesNoCancel, "Alert")

Case Is = vbYesThisWorkbook.Save

Case Is = vbCancel

Exit Sub

End Select

Set myRange = Selection

For Each myCell In myRange

If Not IsEmpty(myCell) Then

myCell = Trim(myCell)

End If

Next myCell

End Sub

74. Remove Characters from a String

Simply remove characters from the starting of a text string.

All you need is to refer to a cell or insert a text into the function and number of characters to

remove from the text string.

It has two arguments "rng" for the text string and "cnt" for the count of characters to remove.

For example: If you want to remove first characters from a cell, you need to enter 1 in cnt.

Public Function removeFirstC(rng As String, cnt As Long)

removeFirstC = Right(rng, Len(rng) - cnt)

removeFirstC = Right(rng, Len(rng) - cnt)

End Function

75. Add Insert Degree Symbol in Excel

Let’s say you have a list of numbers in a column and you want to add degree symbol with all of

them.

Sub degreeSymbol( )

Dim rng As Range

For Each rng In Selection

rng.Select

If ActiveCell <> "" Then

If IsNumeric(ActiveCell.Value) Then

ActiveCell.Value = ActiveCell.Value & "°"

End If

End If

Next

End Sub

76. Reverse Text

All you have to do just enter "rvrse" function in a cell and refer to the cell in which you have text

which you want to reverse.

Public Function rvrse(ByVal cell As Range) As String

rvrse = VBA.strReverse(cell.Value)

End Function

77. Activate R1C1 Reference Style

This macro code will help you to activate R1C1 reference style without using Excel options.

Sub DataForm()

ActiveSheet.ShowDataForm

End Sub

78. Activate A1 Reference Style

This macro code will help you to activate A1 reference style without using Excel options.
Sub ActivateA1()

If Application.ReferenceStyle = xlR1C1 Then

Application.ReferenceStyle = xlA1

Else

Application.ReferenceStyle = xlA1

End If

End Sub

79. Insert Time Range

With this code, you can insert a time range in sequence from 00:00 to 23:00.

Sub TimeStamp()

Dim i As Integer

For i = 1 To 24

ActiveCell.FormulaR1C1 = i & ":00"

ActiveCell.NumberFormat = "[$-409]h:mm AM/PM;@"

ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select

Next i

End Sub

80. Convert Date into Day

If you have dates in your worksheet and you want to convert all those dates into days then this

code is for you.

Simply select the range of cells and run this macro.

Sub date2day()

Dim tempCell As Range

Selection.Value = Selection.Value

For Each tempCell In Selection

If IsDate(tempCell) = True Then

With tempCell

.Value = Day(tempCell)

.NumberFormat = "0"

End With

End If

Next tempCell
Next tempCell

End Sub

81. Convert Date into Year

This code will convert dates into years.

Sub date2year()

Dim tempCell As Range

Selection.Value = Selection.Value

For Each tempCell In Selection

If IsDate(tempCell) = True Then

With tempCell

.Value = Year(tempCell)

.NumberFormat = "0"

End With

End If

Next tempCell

End Sub

82. Remove Time from Date

If you have time with the date and you want to remove it then you can use this code.

Sub removeTime()

Dim Rng As Range

For Each Rng In Selection

If IsDate(Rng) = True Then

Rng.Value = VBA.Int(Rng.Value)

End If

Next

Selection.NumberFormat = "dd-mmm-yy"

End Sub

83. Remove Date from Date and Time

It will return only time from a date and time value.

Sub removeDate()

Dim Rng As Range

For Each Rng In Selection

If IsDate(Rng) = True Then

Rng.Value = Rng.Value - VBA.Fix(Rng.Value)

End If

NextSelection.NumberFormat = "hh:mm:ss am/pm"

End Sub

84. Convert to Upper Case

Select the cells and run this code.

It will check each and every cell of selected range and then convert it into upper case text.

Sub convertUpperCase()

Dim Rng As Range

For Each Rng In Selection

If Application.WorksheetFunction.IsText(Rng) Then

Rng.Value = UCase(Rng)

End If

Next

End Sub

85. Convert to Lower Case

This code will help you to convert selected text into lower case text.

Just select a range of cells where you have text and run this code.

If a cell has a number or any value other than text that value will remain same.

Sub convertLowerCase()

Dim Rng As Range

For Each Rng In Selection

If Application.WorksheetFunction.IsText(Rng) Then

Rng.Value= LCase(Rng)

End If

Next

End Sub

86. Convert to Proper Case

And this code will convert selected text into the proper case where you have the first letter in

capital and rest in small.

Sub convertProperCase()

Dim Rng As Range

For Each Rng In Selection

If WorksheetFunction.IsText(Rng) Then

Rng.Value= WorksheetFunction.Proper(Rng.Value)

End If

Next

End Sub

87. Convert to Sentence Case

In text case, you have the first letter of the first word in capital and rest all in words in small for

a single sentence and this code will help you convert normal text into sentence case.

Sub convertTextCase()

Dim Rng As Range

For Each Rng In Selection

If WorksheetFunction.IsText(Rng) Then

Rng.Value= UCase(Left(Rng, 1)) & LCase(Right(Rng, Len(Rng) -1))

End If

Next rng

End Sub

88. Remove a Character from Selection

To remove a particular character from a selected cell you can use this code.

It will show you an input box to enter the character you want to remove.

Sub removeChar()

Dim Rng As Range

Dim rc As String

rc = InputBox("Character(s) to Replace", "Enter Value")

For Each Rng In Selection

Selection.Replace What:=rc, Replacement:=""

Next
Next

End Sub

89. Word Count from Entire Worksheet

It can help you to count all the words from a worksheet.

Sub Word_Count_Worksheet()

Dim WordCnt As Long

Dim rng As Range

Dim S As String

Dim N As Long

For Each rng In ActiveSheet.UsedRange.Cells

S = Application.WorksheetFunction.Trim(rng.Text)

N = 0

If S <> vbNullString Then

N = Len(S) - Len(Replace(S, " ", "")) + 1

End If

WordCnt = WordCnt + N

Next rng

MsgBox "There are total " & Format(WordCnt, "#,##0") & " words

in the active worksheet"

End Sub

90. Remove the Apostrophe from a Number

If you have numeric data where you have an apostrophe before each number, you run this code

to remove it.

Sub removeApostrophes()

Selection.Value = Selection.Value

End Sub

91. Remove Decimals from Numbers

This code will simply help you to remove all the decimals from the numbers from the selected

range.

Sub removeDecimals()

Dim lnumber As Double

Dim lResult As Long

Dim rng As Range

For Each rng In Selection

rng.Value= Int(rng)

rng.NumberFormat= "0"

Next rng

End Sub

92. Multiply all the Values by a Number

Let’s you have a list of numbers and you want to multiply all the number with a particular.

Just use this code.

Select that range of cells and run this code. It will first ask you for the number with whom you

want to multiple and then instantly multiply all the numbers with it.

Sub multiplyWithNumber()

Dim rng As Range

Dim c As Integer c = InputBox("Enter number to multiple",

"Input Required")

For Each rng In Selection

If WorksheetFunction.IsNumber(rng) Then

rng.Value = rng * c

Else

End If

Next rng

End Sub

93. Add a Number in all the Numbers

Just like multiplying you can also add a number into a set of numbers.

Sub addNumber()

Dim rngAs Range

DimiAs Integer

i= InputBox("Enter number to multiple", "Input Required")

For Each rng In Selection

If WorksheetFunction.IsNumber(rng) Then

rng.Value= rng+ i
rng.Value= rng+ i

Else

End If

Next rng

End Sub

94. Calculate the Square Root

To calculate square root without applying a formula you can use this code.

It will simply check all the selected cells and convert numbers to their square root.

Sub getSquareRoot()

Dim rngAs Range

Dim i As Integer

For Each rng In Selection

If WorksheetFunction.IsNumber(rng) Then

rng.Value= Sqr(rng)

Else

End If

Next rng

End Sub

95. Calculate the Cube Root

To calculate cube root without applying a formula you can use this code.

It will simply check all the selected cells and convert numbers to their cube root.

Sub getCubeRoot()

Dim rng As Range

Dimi As Integer

For Each rng In Selection

If WorksheetFunction.IsNumber(rng) Then

rng.Value = rng ^ (1 / 3)

Else

End If

Nextrng

End Sub
96. Add A-Z Alphabets in a Range

Just like serial numbers you can also insert alphabets in your worksheet. Beloware the code

which you can use.

Sub addcAlphabets()

Dim i As Integer

For i= 65 To 90

ActiveCell.Value= Chr(i)

ActiveCell.Offset(1, 0).Select

Next i

End Sub

Sub addsAlphabets()

Dim i As Integer

For i= 97 To 122

ActiveCell.Value= Chr(i)

ActiveCell.Offset(1, 0).Select

Next i

End Sub

97. Convert Roman Numbers into Arabic Numbers

Sometimes it’s really hard to understand Roman numbers as serial numbers. This code will help

you to convert roman numbers into Arabic numbers.

Sub convertToNumbers()

Dim rng As Range

Selection.Value= Selection.Value

For Each rng In Selection

If Not WorksheetFunction.IsNonText(rng) Then

rng.Value= WorksheetFunction.Arabic(rng)

End If

Next rng

End Sub

98. Remove Negative Signs

This code will simply check all the cell in the selection and convert all the negative numbers into

positive. Just select a range and run this code.

Sub removeNegativeSign()

Dim rngAs Range

Selection.Value= Selection.Value

For Each rngIn Selection

If WorksheetFunction.IsNumber(rng)

Then rng.Value= Abs(rng)

End If

Next rng

End Sub

99. Replace Blank Cells with Zeros

For data where you have blank cells, you can use the below code to add zeros in all those cells.

It makes easier to use those cells in further calculations.

Sub replaceBlankWithZero()

Dim rngAs Range

Selection.Value= Selection.Value

For Each rngIn Selection

If rng= "" Or rng= " " Then

rng.Value= "0"

Else

End If

Next rng

End Sub

100th
It’s your turn now.

Yes.

I want you to share your favorite macro code with me which you use every day to save your

time. In the end, I just want to say that some of these codes I use every day to increase my

productivity and I’m sure it will also help you in your work.

 Share  Tweet
About the Author

Puneet is using Excel since his college days. He helped thousands of people to understand

the power of the spreadsheets and learn Microsoft Excel. You can find him online, tweeting

about Excel, on a running track, or sometimes hiking up a mountain.

Learn Excel (Videos)

Connect with Puneet

154 thoughts
Leave a Comment
Your email address will not be published.

Name *

Email *

Website

Post Comment

Coral
13 Jan, 20 at 5:22 am

HI Punith,

I need your advice on the macros codes on how to open embedded files in excel and

trigger the owner of that file of the due date..

Reply

Archana
5 Dec, 19 at 6:53
pm

Thank you Punith. This is useful for us. I want to learn vba code. But feeling difficulty.

How do i start as a fresher. Like first I need to start from userform or code line through

module?

give some easy tips Plse.

Reply

Tom White
29 Nov, 19 at 3:24 am

Thanks Puneet, Excellent Work. You have given me the start I have been looking for.

Reply

Puneet
29 Nov, 19 at 12:51
pm

Don’t forget to check out this guide https://excelchamps.com/vba-tutorials/

Reply

Gehad Alahdal
26 Nov, 19 at 11:25 am

Hi Dear,

May I have your assistance for VBA code Tab Order, I have made Invoice, I would like to

use Tab for certain cells to fillup, for example, the cells are C3,C7,C9,D9,F7,F9,F11 and so

on.

Please, simple VBA code Tab Order, as simple as you can.

Many thanks,

Reply
 Ankit Singh
14 Nov, 19 at 6:06 am

Hi,

i have a query with regard macro.

Function timestamp(Reference As Range)

If Reference.Value “” Then

timestamp = Format(Now, “dd-mmm-yy hh:mm:ss”)

Else
Ok = “”

End If

End Function

this code show text format show date but i want date format please help sir.

Reply

Mustafa Ramadan
3 Nov, 19 at 6:57 am

Excuse me,

can you tell me what is the wrong in this code

Dim Name As String

Dim Barcode As Long

Dim vender As String

Name = Sheets(“Add”).Range(“c5”).Value

Barcode = Sheets(“Add”).Range(“c8”).Value

vender = Sheets(“Add”).Range(“f14”).Value

because this can’t run ( Barcode=sheets…………….)

Reply
 lilly
28 Oct, 19 at 3:42 am

Any advice on how to automate a search on Excel for over 3000 words/phrases from 20

different categories in a cell and return the category that contains the phrase? I don’t

know any macro coding but am exploring this as an option since the manual formula is

longer than the maximum cell character limit.

Reply

pwyller
9 Oct, 19 at 1:39
pm

Tried two subs – neither worked – at least not in 2016.

Reply

Puneet
9 Oct, 19 at 5:15
pm

Hey Pwyller, which two?

Reply

Himanshu
28 Sep, 19 at 11:03 am

Hi Everyone,

Thanks for gathering all Codes. It takes lot of work.

I want to write code for Adding Rows for below details.

ABCDEF

1 24

2 25

3 28

4 33

Add 2 rows between A2 & A3 and

Add 4 rows between A3 & A4.

Thanks in advance.

Reply

Shakya
19 Sep, 19 at 12:32
pm

Hi Puneet,

I need your help, Actually I’m stuck with an error-> run-time error: ‘1004’, Method ‘Run’ of

object ‘_Application’ failed and the highlighted line in {Application.Run

Macro:=Range(“Datablock”)} where datablock is a named range which has already defined.

It is very important to me. So, please Reply ASAP

Reply

Karthi
16 Sep, 19 at 7:36 am

Hi Everyone… i’m used report merging macro using text box and command button.

Private Sub CommandButton2_Click()

Dim fd As Object

Dim add As String

Dim wb As Workbook, wk As Workbook

Dim myfiles As String

Dim name As String

If TextBox1.Text = “” Then

MsgBox “Pls Select Path”, vbInformation

Else

Set fd = Application.FileDialog(msoFileDialogFilePicker)

myfiles = Dir(“” + TextBox1.Text + “*.xlsx”)

If myfiles = “” Then

MsgBox “This folder haven’t Excel files… Can’t do further Process..”, vbInformation

Else

ThisWorkbook.Activate

Worksheets.add

On Error GoTo errHandler:

ActiveSheet.name = “Summary”

Sheets(“Lables”).Activate

ActiveSheet.Range(“A1:AM1”).Select

Selection.Copy

ActiveSheet.Range(“A1”).Select

Sheets(“Summary”).Activate

ActiveSheet.Range(“A1”).Select

ActiveSheet.Paste

ActiveSheet.Range(“A2”).Select

Do While myfiles “”

Set wb = Workbooks.Open(“” + TextBox1.Text + “” & myfiles)

name = ActiveSheet.name

wb.Sheets(name).Activate

wb.Sheets(name).Range(“A2:AM2”).Select

wb.Sheets(name).Range(Selection, Selection.End(xlDown)).Select

Selection.Copy
myfiles = Dir

ThisWorkbook.Activate

ThisWorkbook.Sheets(“Summary”).Activate

If ActiveSheet.Range(“A2”) = “” Then

ActiveSheet.Paste

Application.CutCopyMode = False

ThisWorkbook.Sheets(“Summary”).Columns.AutoFit

ThisWorkbook.Sheets(“Summary”).Range(“A1”).Select

Selection.End(xlDown).Select

add = ActiveCell.Address
wb.Sheets(name).Activate
Application.CutCopyMode = False

ActiveWorkbook.Close

Else

ActiveCell.Offset(1, 0).Select

ActiveSheet.Paste

Application.CutCopyMode = False

ThisWorkbook.Sheets(“Summary”).Columns.AutoFit

ThisWorkbook.Sheets(“Summary”).Range(“A1”).Select

Selection.End(xlDown).Select

add = ActiveCell.Address

wb.Sheets(name).Activate

Application.CutCopyMode = False

ActiveWorkbook.Close

End If

Loop

ActiveSheet.Range(“A1”).Select

MsgBox “Process completed”, vbInformation

End If

End If

errHandler:

num = Sheets.Count

If num > 3 Then

MsgBox “Kindly delete previous data..!”, vbInformation

ThisWorkbook.Sheets(“Summary”).Activate

End If

End Sub

Reply

Pascal.
13 Sep, 19 at 12:37 am

Hi Puneet,

Thanks for gathering all this code! Amazing work! I’m looking forward to test some of it
during my day to day excel work.

Keep it up!

Reply

Ankitha
10 Sep, 19 at 6:51 am

Hi Sir,

I have a query with regards to macros in excel, could I contact you via email?

WIth Regards,

Ankitha

Reply

sam
3 Sep, 19 at 11:44 am

i want to hyperlink my image with website url plz help me for hyperling my image! and i

want to send it to outlook

Sub Send_email_fromexcel()

Dim edress As String

Dim subj As String

Dim message As String

Dim filename, fname2 As String

Dim outlookapp As Object

Dim outlookmailitem As Object

Dim myAttachments As Object

Dim path As String

Dim lastrow As Integer

Dim attachment As String

Dim x As Integer

x=2

Set outlookapp = CreateObject(“Outlook.Application”)

Set outlookmailitem = outlookapp.createitem(0)

Set myAttachments = outlookmailitem.Attachments

path = “C:UsersUserDesktopstatements”

edress = Sheet1.Cells(x, 1)

subj = Sheet1.Cells(x, 2)

filename = Sheet1.Cells(x, 3)
fname2 = “Weddingplz-Safe-Gold.jpg”

attachment = path + filename

outlookmailitem.to = edress

outlookmailitem.cc = “”

outlookmailitem.bcc = “”

outlookmailitem.Subject = subj

outlookmailitem.Attachments.Add path & fname2, 1

outlookmailitem.htmlBody = “Thank you for your contract” _

& “nicely done this work” _

& “”

outlookmailitem.htmlBody = “” & outlookmailitem.htmlBody & “”

‘outlookmailitem.body = “Please find your statement attached” & vbCrLf & “Best Regards”

outlookmailitem.display

‘outlookmailitem.send

lastrow = lastrow + 1

edress = “”

x=x+1

Set outlookapp = Nothing

Set outlookmailitem = Nothing

End Sub

Reply

Arpit
28 Aug, 19 at 1:40
pm

hi, what is the vba code to highlight the entire row based on cell value?

Reply

Cmo
2 Sep, 19 at 3:11 am

Sub ColorRow()

Dim cel As Range

Dim rng As Range

Dim wrksht As Worksheet

Set wrksht = ThisWorkbook.Worksheets(“Sheet1”) ‘put your worksheet name in place of

sheet1

Set rng = wrksht.Range(“A1:A10”) ‘Change “A1:A10” to your range

For Each cel In rng

If cel = “Whatever value” Then ‘insert your value in place of “Whatever Value”

cel.EntireRow.Interior.ColorIndex = 3 ‘colors row red

End If

Next cel

End Sub

Reply
 Pratik
22 Aug, 19 at 12:36
pm

Can you share a code which combines certain numbers (positive & negative) from a given

table and calculates to a certain number (say ‘0’)?

Reply

Micky
20 Aug, 19 at 3:23
pm

Thank you for sharing this make internet better!!, good tips & tricks

Reply

knust
2 Aug, 19 at 11:10 am

Please I want you to help me

Reply

SuBui
20 Jul, 19 at 3:16
pm

Thank you so much!

Reply
 Nagamalla Satish
25 May, 19 at 5:57
pm

thanks a lot .

Reply

MICHAEL
23 May, 19 at 5:49
pm

hi guys,

thanks for lot of codes posted, quite helpful,

please i need a code to extract a particular worksheet from multiple workbooks saved in a

folder without opening the workbook, using the sheet name as a criteria to search

Reply

Ria ariarini
18 May, 19 at 3:40
pm

so much thank you

i need more helpful code for time function.

1.i need to perfom the procedure/action in specific duration (not to start or scheduling the

action). For example playing the game only for 1 minute, if > 1 minute the game stop

automatically.

2.If i have a cell with time format, how to execute the function? For example, i want to

move the shape if the cell less or equal to “0:10:00” but if the cell contain over, lets say

“0:15:00”, you can’t not activate the movement

Thanks
Reply

Darshana kesaria
9 May, 19 at 9:25
am

Hi puneet

Very useful blog

Pl suggest any online classes

As I am on maternity leave can give only around 1 hrs a dag.

Secondly no knowledge of programming..

Codes required for

Auto sorting
Removing duplicates

Subtotaling of auto sorted

Automatically adding the new name in the previously sorted data.

Creating a balance sheet from trial balance

Creating a customized bom…

Reply

Zabihullah
6 May, 19 at 7:55
pm

What is the: save, Delet, Reset, and exit cods in macro

Can you send me please

Reply

Prince
3 May, 19 at 12:24 am
Do you have something to read a json file from upcitemdb.com?

I need to get price, picture and merchant link, if you have some vba to do that, please

share Bro.

Reply

Puneet
3 May, 19 at 5:57 am

Try Power Query for that

Reply

verolee213
1 Sep, 19 at 11:58
pm

@Prince
There’s a Google Sheet Add-in. Scan barcodes and Run the add-in. I don’t know if it’s

UPCITEMDB or a different database, but it gave me the results that you’re looking for.

Reply

Liz
18 Apr, 19 at 12:15 am

I love the table of content code. Thank you so much! Is there a code to have a link to go
back to the Table of Content on each of the other tabs?

Reply
 Nathan
9 Jul, 19 at 3:42 am

Hi Liz,

This can be done by including something like this:

Sub TableofContent()

Dim i As Long, wks As Worksheet

On Error Resume Next

Application.DisplayAlerts = False

Worksheets(“Table of Content”).Delete

Application.DisplayAlerts = True

On Error GoTo 0

Sheets.Add(Before:=Sheets(1)).Name = “Table of Content”

‘ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
‘ActiveSheet.Name = “Table of Content”

For i = 1 To Sheets.count

With ActiveSheet

.Hyperlinks.Add _

Anchor:=ActiveSheet.Cells(i, 1), _

Address:=””, _

SubAddress:=”‘” & Sheets(i).Name & “‘!A1”, _

ScreenTip:=Sheets(i).Name, _

TextToDisplay:=Sheets(i).Name

End With

If Sheets(i).Name = “Table of Content” Then

‘Skip this page

Else

Sheets(i).Range(“A1”).Hyperlinks.Add Anchor:=Sheets(i).Range(“A1″), Address:=””,

SubAddress:= _

“‘Table of Content’!A1″, TextToDisplay:=”TOC”

End If

Next i

End Sub

Reply
 Ashish
16 Apr, 19 at 12:53
pm

Great Stuff! Thank you for sharing. Can you please post a code on how to attach a pdf

document to outlook

Reply

Zar Li Chan
15 Apr, 19 at 12:16
pm

Thank for knowledge sharing.

This is very useful page for VBA learner.

Reply

mw
10 Apr, 19 at 7:58 am

Hi when using below code I get an error message:

Sub printSelection()

Selection.PrintOutCopies:=1, Collate:=True

End Sub

Compile error Syntax error

Am I doing something wrong?

Reply
 mick
10 Apr, 19 at 7:56 am

Sub printSelection()

Selection.PrintOutCopies:=1, Collate:=True
End Sub

gives an error message for me: Compile error Syntax error

am I doing something wrong?

Reply

mick
10 Apr, 19 at 7:47
am

This is very helpful, as I am fully new to macro’s. Maybe a very basic q. If I for example use

the following macro “1. Highlight Duplicates from Selection” how can I afterwards undo

this? Other words is there also an “undo previous action” macro as in above case in my

excel sheet the duplicate values remain coloured

Reply

Sunny
2 Apr, 19 at 4:28
pm

Hi,

I want to compare current report and previous report to master file. All of them has a two

row. First compare current to master and print result if it is match. Second, compare

previous to master file and print result if it match. I don’t know how to do in VBA. Can you

please help me

Reply
 Somesha A R
1 Apr, 19 at 7:07 am

Hi puneet, It’s extremely nice efforts. everyday I’am learning something from the website

but couldn’t save the PDF file. can you please share me the PDF document to my mail id

([email protected])

Thank you

Reply

Lauren
21 Mar, 19 at 3:33
pm

I would love to have a macro code to replace a sheet name in a formula

Reply

Vikram
20 Mar, 19 at 9:34 am

Paste as linked picture was nice. I had used record macro to get the basic code for it, but

yours is much simpler and cleaner.

My most often used macro is to Paste as Values (instead of copying the formula)

Sub PasteValues()

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

End Sub

(again recorded). I use Ctrl+Shift+V as a shortcut, so after copying with Ctrl+C, I can paste
formulas or values based on whether I press shift along with my Ctrl+V

Another 1 I use is for borders, keyboard shortcut: Ctrl+Shift+B

Sub Border()
Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.TintAndShade = 0

.Weight = xlThin
End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic
.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.TintAndShade = 0

.Weight = xlHairline

End With
End Sub

I have also 1 user form designed as a general Notification to tell me that the macro is

running, and then to update after execution is completed. Similarly, I have a user form as

a progress bar.

Instead of manually setting up the user forms each time, I have separate macros that

update the user form and enable/disable screen updating and auto calculation.

Eg:

Sub MacroStart()

Notification.Button.Enabled = False

Notification.Message.Caption = “Macro running… Please Wait”

Notification.Show (vbModeless)

Application.ScreenUpdating = False

Application.Calculation = xlManual
Notification.Repaint

End Sub

Sub MacroStop()

Application.ScreenUpdating = True

Application.Calculation = xlAutomatic

Notification.Button.Enabled = True

Notification.Message.Caption = “Macro execution completed”

Notification.Repaint

End Sub

I can just call MacroStart at the start of each macro, and MacroStop at the end of the

macro, and those handle all the user form and enable/disable stuff for me.

Reply

Rui Mateus
17 Mar, 19 at 7:48
pm

Thank you. Great work!!!!

Save to PDF its really usefull.

Reply
 samad
17 Mar, 19 at 6:02 am

Hello,

I have a macro which will consolidate all workbooks to single sheet but i need to have

files names as well in each row to indentify how many lines from workbook

Reply

Puneet
17 Mar, 19 at 12:40
pm

https://excelchamps.com/blog/merge-excel-files-one-workbook/

Reply

george
10 Mar, 19 at 10:44
pm

I particularly like this code for Superscripting when I want to show X squared for example.

It can be modified to subscript as well and to return back to regular text.

When writing out problems with formulas for students this can be easier than using the

format/ cell with the mouse.

ActiveCell.FormulaR1C1 = “X2”
With ActiveCell.Characters(Start:=1, Length:=1).Font

.Name = “Calibri (Theme Body)”

.FontStyle = “Regular”

.Size = 12

.StrikeThrough = False

.Superscript = False

.Subscript = False
.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone
End With

With ActiveCell.Characters(Start:=2, Length:=1).Font

.Name = “Calibri (Theme Body)”

.FontStyle = “Regular”

.Size = 12

.StrikeThrough = False

.Superscript = False

.Subscript = True

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

End With

End Sub

Reply

kumar
8 Mar, 19 at 7:34 am

i need one help a3 cell value is 20 so need left to right rented value 20 time (1111111111111)

(b3 cell 1 c3 cell 1 d3 cell 1)

Reply

pathiban
2 Mar, 19 at 1:36 am

Thank You Very Much.Its all very useful. I suggest one thing please comment how to use

the each codes some of the codes can run only by coder.

Reply
 santha ram
20 Feb, 19 at 5:51 am

Hai,

I need the numbers 1-100 or 1-1000 in a jumbling manner. is there any code, i need it very

urgently. pls. can u help me in this.

Reply

Josh
6 Mar, 19 at 5:45 am

You don’t need a code for that. You just need a formula. Use =rand() and =rank() if you

don’t want duplicates.

If you’re fine with duplicates you could use =randbetween(1,1000)

Check this website out.

https://trumpexcel.com/generate-unique-random-numbers-in-excel/

Reply

Sandeep
6 Feb, 19 at 12:23
pm

Hey Buddy,

thanks a ton. your macros are of great help.

can you create a macro wherein i can remove formulas from cells where cell value is not

in percentage.

Reply
 Sumit
5 Feb, 19 at 8:45
pm

Hi,

I dont know macro well.

I want a code where I just put data in sheet1 and the pivot charts automatic created. Can

anyone please help me on this.

It is very urgent.

Reply

Sumit
5 Feb, 19 at 8:41
pm

In this below code how I will define range. I just put data in sheet1 I dont know the data

size like how much column and row are present in the data. So I want to put some

dynamic range so that any data can useful.

Please help ASAP.

Sub Macro2()

‘ Macro2 Macro

‘
‘

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlDown)).Select

Sheets.Add

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

“Sheet1!R1C1:R6C73″, Version:=xlPivotTableVersion15).CreatePivotTable _

TableDestination:=”Sheet2!R3C1″, TableName:=”PivotTable1”, DefaultVersion _

:=xlPivotTableVersion15

Sheets(“Sheet2”).Select

Cells(3, 1).Select

With ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Created Date”)

.Orientation = xlRowField

.Position = 1

End With

ActiveSheet.PivotTables(“PivotTable1”).AddDataField ActiveSheet.PivotTables( _

“PivotTable1”).PivotFields(“Incident Id”), “Count of Incident Id”, xlCount

ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select

ActiveChart.SetSourceData Source:=Range(“Sheet2!$A$3:$B$8”)

End Sub

Reply

prabeesh
23 Jan, 19 at 12:00
pm

Is there any formula to create different file from single work sheet?

Reply

ranjitha das
22 Jan, 19 at 1:11
pm

Dear Puneet,

This site is amazing and i get to learn something new every passing day. Sincere thanks for

your time and initiative.

I am trying to create a date stamp button (using form control) that will add customized

date and time of printing in the excel footer – using a specific font, font size and font

color (e.g. Veranda, 8pt, Blue)

The end result would look something like this:

Printed on dd-mmm-yyyy at hh:mm:ss

I don’t want the time stamp to be inserted automatically, but rather use a form control

button to insert the same when clicked.

Could you kindly help me with the VBA code please? It will be a great help!
TIA for you help & warm regards

Ranjitha

Reply

Puneet
23 Jan, 19 at 7:19 am

Thanks for your words, I need to write an entire blog post for it, stay tuned.

Reply

somasundaram
21 Jan, 19 at 7:02
pm

Hi puneet,

I’m somu i don’t know vb code could you please tell me vb code basic knowledge share to

my mail i’d : [email protected]

Reply

Karan Parmar
29 Dec, 18 at 6:12
am

Hi Puneet

I am looking for a stock report with a huge data my requirement is

Material dispatch planning (Main Moto – FIFO Basis)

Outstanding Orders

Reply
 HARSH PRATAP SINGH
26 Dec, 18 at 3:41 pm

Hi Punnet

First of all ” Thanks a lot for the Great Work ”

I am looking for a code that will consolidate data from multiple excel files in a specific

folder to a new blank excel file.

Reply

Puneet
27 Dec, 18 at 5:22
am

I’m writing a blog post about, it will update once it’s done.

Update: https://excelchamps.com/blog/merge-excel-files-one-workbook/

Reply

Abhishek Chordiya
1 Jan, 19 at 10:32 am

I hope below 2 VBA Code will help you in your question…

1. Combine Multiple Workbooks into One Workbook:

Sub GetData()

Dim sh As Worksheet

Path = “D:\(Give Path Name where all excel files are saved)\”

Filename = Dir(Path & “*.xlsx”)

Do While Filename “”

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

For Each sh In ActiveWorkbook.Worksheets

‘If LCase(Left(sh.Name, 5)) = “model” Then

sh.Copy After:=ThisWorkbook.Sheets(1)

‘End If
Next sh

Workbooks(Filename).Close

Filename = Dir()

Loop

End Sub

2. To Combine Multiple Worksheets into One WorkSheet.:

Sub Combine()
Dim J As Integer

On Error Resume Next

Sheets(1).Select

Worksheets.Add

Sheets(1).Name = “Data”

Sheets(2).Activate

Range(“A1”).EntireRow.Select

Selection.Copy Destination:=Sheets(1).Range(“A1”)

For J = 2 To Sheets.Count

Sheets(J).Activate

Range(“A1”).Select

Selection.CurrentRegion.Select

Selection.Offset(1, 0).Resize(Selection.Rows.Count – 1).Select

Selection.Copy Destination:=Sheets(1).Range(“A65536”).End(xlUp)(2)

Next

End Sub

Reply

KARTHIKEYAN
30 Jan, 19 at 5:36
am

Hi sir,

i need your help.

I will download one file 10000 lines coming one excel sheet.

every line mentions the Projects No.

Project no wise split the data to convert the workbook

if it is possible to share the coding

 Reply

KARTHIKEYAN
30 Jan, 19 at 5:40 am

How To Split A Workbook To Separate Excel Files In Excel?

Reply

sachin gupta
21 Dec, 18 at 5:39
am

these are really helpful for beginners

Reply

Afru Marma
19 Dec, 18 at 7:01
am

Thank you so much sir.

Reply

Manish
17 Dec, 18 at 5:57
pm

Hello,
I would like to know the VBA code to copy an active sheet to multiple sheets in the same

work book.

Thank you

Reply

Sreedhar
13 Dec, 18 at 1:29
pm

ExcelChamps, Good evening. I’m new to VBA. Excuse me if my question too silly. I have a

column in which there will be names of cities. If I type/select that name from drop down

list, excel should populate pin code number in the next column. Also some other columns

to be autofilled. For example, point of contact name and number of that city. My EmailID

is [email protected]. Thanks in advance

Reply

Anna
10 Aug, 19 at 9:59 am

Hello, I’m here for the same reason, looking for where I can find people to help me

populate some data in excel. Did you get any answer, I would really like to know if I can

get any help.

Reply

Mike Wright
7 Dec, 18 at 10:01
pm

Hi I am Looking for a way to convert a Rage Named which is and auto Start Name xls in XP

Excel 97-2003 to vba code in Excel 2010 Windows 10 Is there a Way? or do I just need to
start over?

Reply

Courtney
6 Dec, 18 at 9:55
pm

I could not get the code for highlighting the row and column of the cell I’m working on to

function:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim strRange As String

strRange = Target.Cells.Address & “,” & _

Target.Cells.EntireColumn.Address & “,” & _

Target.Cells.EntireRow.Address

Range(strRange).Select

End Sub

Any suggestions?

Reply

Martin
12 Dec, 18 at 7:03
am

It worked for me when changing the quotation marks from “” to “”

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim strRange As String

strRange = Target.Cells.Address & “,” & _

Target.Cells.EntireColumn.Address & “,” & _

Target.Cells.EntireRow.Address

Range(strRange).Select

End Sub

Reply
 Martin Schmidt
6 Dec, 18 at 11:40
am

Here are some of the codes I use on a daily basis.

Function ConvertColumnNumberToLetter(colNum)

‘Getting the address of the first row and the colNum column number
colAdr = ActiveWorkbook.ActiveSheet.Cells(1, colNum).Address

With Application.WorksheetFunction

colLetter = .Find(“$”, colAdr, 2) ‘Finding the second $-sign in the address

ConvertColumnNumberToLetter = Mid(colAdr, 2, colLetter – 2) ‘Extracting the middle part

of the address, containing only the letter(s) and returning it/them

End With

End Function

Function ConvertColumnLetterToNumber(colLet As String)

With ActiveWorkbook.ActiveSheet

colAdr = .range(colLet & 1).Address ‘Getting the address of the first row and the colNum

column number

ConvertColumnLetterToNumber = .range(colAdr).Column ‘Getting the column number of

the address

End With

End Function

Function SendSelectionAsEmail(rng As range, subj As String, sendTo As String, Optional

ccTo As String, Optional intro As String)

‘ Select the range of cells on the active worksheet.

ActiveSheet.range(rng).Select

‘ Show the envelope on the ActiveWorkbook.

ActiveWorkbook.EnvelopeVisible = True
‘ Set the optional introduction field thats adds

‘ some header text to the email body. It also sets

‘ the To and subject lines. Finally the message

‘ is sent.

With ActiveSheet.MailEnvelope

.Introduction = intro

.Item.To = sendTo
.Item.CC = ccTo

.Item.Subject = subj

.Item.Send

End With
End Function

Function ConvertCollectionToArray(col As Collection)

Dim arr() As Variant

ReDim arr(1 To col.Count) As Variant

For i = 1 To col.Count

arr(i) = col(i)

Next i

toArray = arr

End Function

Function LastRow(ws As Worksheet, columnNumberToCheck)

LastRow = ws.Cells(Rows.Count, columnNumberToCheck).End(xlUp).Row

End Function

Function LastColumn(ws As Worksheet, rowNumberToCheck)

LastColumn = ws.Cells(rowNumberToCheck, Columns.Count).End(xlToLeft).Column

End Function

Function GetLastRowAdvaned(ws As Worksheet, endColumnNumber) ‘Looping through all

columns from 1 to the end column number and finding the max value

maxVal = 0

For i = 1 To endColumnNumber

If LastRow(ws, i) > maxVal Then

maxVal = LastRow(ws, i)

End If
Next i

GetLastRowAdvaned = maxVal

End Function

Function IsRowEmpty(ws As Worksheet, rowNumberToCheck, endColumnNumber) As

Boolean

Dim isEmpty As Boolean

isEmpty = True

For i = 1 To endColumnNumber

If ws.range(Cells(rowNumberToCheck, i).Address) = “” Then

IsRowEmpty = True

Else

IsRowEmpty = False
GoTo EndFunction:

End If

Next i

EndFunction:

IsRowEmtpy = isEmpty

End Function

Reply

BRANDON
5 Dec, 18 at 3:40
am

This macro will promt you to select a photo, then it will size the height ,width and insert it

to a specific range.

Sub Insert_Setup_Photo()

ActiveSheet.Protect DrawingObjects:=False

Dim picToOpen As String

picToOpen = Application.GetOpenFilename _

(Title:=”Select Setup Photo To Insert”)

If picToOpen = “False” Then

ActiveSheet.Protect DrawingObjects:=False, Contents:=True

Exit Sub

End If

Dim shp As Shape, t As Double, l As Double, w As Double, h As Double, r As Integer

Dim Cel As Range

CellHeight = 375 ‘Final Image Height, maintains scale

CellWidth = 670 ‘Final Image Width, maintains scale

Set Cel = Range(“B5:M29”) ‘Cells image be centered

With Cel
Set shp = ActiveSheet.Shapes.AddPicture(Filename:=picToOpen, _

LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, Left:=0, Top:=0, Width:=-1,

Height:=-1)

shp.Locked = False

shp.Height = CellHeight

If shp.Width > CellWidth Then

shp.Width = CellWidth

End If

shp.Left = .Left + ((.Width – shp.Width) / 2)

shp.Top = .Top + ((.Height – shp.Height) / 2)

End With

ActiveSheet.Protect DrawingObjects:=False, Contents:=True

End Sub

Reply

Vivekanand Kola
27 Nov, 18 at 2:10
am

I Would like move the cursor from active cell to one cell left,right(From selected

cell)..same thing to Up and Down by writing macros, Could you please help out resolve

the task. I tried to write the below but its not working fine. Please let me know.

Sub Left(). Ex: Hear Activecell is C2

activecell.offset(0,-1).select -> hear it moves B2 cell

end sub

sub right()

activecell.offset(0,1) .select -> hear it moves C2 But I want to move to D2. Same thing to

Up and Down

end sub

Thanks,

Vivek.

Reply

Alpesh
22 Nov, 18 at 12:44
pm

hi, I want to create Outlook email macro where emails automatically gets saved in to
shared drive. Help needed with coding if anyone knows.

Reply

Ritesh Dev
16 Nov, 18 at 9:27
am

hi punnet sir

thank you for providing macro code. These codes provide me the advantage of time in my

work. these coding also provide my coding awareness . after having understood from

these 100 codes. I have started creating small macro coding.

thank you very much.

Reply

Mahendran R
13 Nov, 18 at 10:14
am

Hi Puneet,

Great job.

Shall i get code for deleting rows if any of the column contains blank cells

Thanks

Reply

Ed Snyder
14 Oct, 18 at 12:25
pm

I need VBR code to work across all worksheets in a workbook a future date will be

manually entered in the same cell on every sheet and new sheets are created daily. On
the actual day of the date entered an email notification would be sent out I also need the

worksheet name in the email so I will know which sheet is due.

Reply

Ravi Patel
26 Sep, 18 at 5:17
pm

Dear, I am using following code for transferring data from one sheet to another sheet,

three variable parameters, i.e. between two dates and center which are selected from

Dropdown menu from Main sheet.

Programme run successfully, but each record written, i should press cancel button, after

last record transfer, all data changed. I think, there is formula on CRM(Data) sheet and

while transferring data formula also transferred, so data will be changed after running.

Pl guide me in the matter.

Sub Module()

‘SelectDataBetweenTwoDates()

‘declare variables

Dim fromDate, toDate

Dim MyResults As Worksheet, myData As Worksheet, MyDates As Worksheet

Dim mModule As String

Set MyResults = Worksheets(“MODCRM”)

Set myData = Worksheets(“CRM”)

Set MyDates = Worksheets(“Main”)

‘clear previous results

MyResults.Range(“$A$3:$K$450”).ClearContents

‘attribute date values to variables

fromDate = MyDates.Range(“D7”).Value

toDate = MyDates.Range(“D9”).Value

mModule = MyDates.Range(“D5”).Value

‘convert to text format to allow filtering

fromDate = Format(fromDate, “dd-mmm-yyyy”)

toDate = Format(toDate, “dd-mmm-yyyy”)

With myData

‘removes autofilter
If .FilterMode Then .ShowAllData

‘filter the data based on selected date values

.Range(“$A$2:$K$2”).AutoFilter field:=7, Criteria1:= _

“>=” & fromDate, Operator:=xlAnd, Criteria2:=”<=" & toDate

.Range("$A$2:$K$2").AutoFilter field:=4, Criteria1:=mModule

'copy the filtered data

.UsedRange.SpecialCells(xlCellTypeVisible).Copy

'paste copied values to results sheet

MyResults.Range("A1").PasteSpecial

End With

' remove autofilter in mydata

'select cell A1 in results sheet

MyResults.Activate

MyResults.Range("A1").Select

End Sub

Please any one can guide me in the matter.

while copying (xlCellTypeVisible) data copied with formula instead of values only.

Pl guide me in the matter.

Ravi Patel

Reply

RAVI PATEL
26 Sep, 18 at 1:12
pm

How to reverse vlookup in VBA on bottom 20 records from 100 records ?

Reply

RAVI PATEL
26 Sep, 18 at 1:08
pm
Hi,

I am using macro for auto filter on multiple filter with between dates and center, every

thing is run successfully, but i have to press cancel button at every record then record

display on screen, after last record, all record changed this i due to formula on sheet,

Any one help me.

Reply

jayesh
26 Sep, 18 at 10:57
am

Hi,

I have Stock and requiremets and required Output as given below.

Stock

Mat Code Mat Description Batch Avlb STK

DS1977S40014C01 CO/SAT/400TC/114/IVORY C16184204 100

DS1977S40014C01 CO/SAT/400TC/114/IVORY C16184206 100

DS1977S40014C01 CO/SAT/400TC/114/IVORY G15833208 100

DS1977S40014C01 CO/SAT/400TC/114/IVORY C16150304 750

DS1977S40014C01 CO/SAT/400TC/114/IVORY C16151502 250

DS1977S40014C01 CO/SAT/400TC/114/IVORY C16151501 250

DS1977S40014C01 CO/SAT/400TC/114/IVORY C16150305 600

Requirements

SR NO Mat Code Mat Description SO Req Qty

3161313530 DS1977S40014C01 CO/SAT/400TC/114/IVORY 300.000

3161313573 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000

3161313574 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000

3161313575 DS1977S40014C01 CO/SAT/400TC/114/IVORY 350.000

3161313576 DS1977S40014C01 CO/SAT/400TC/114/IVORY 500.000

3161313538 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000

3161313539 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000

3161313540 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000

Required OutPut:-

SR No Mat Code Mat Description Req. Qty Batch Available qty Consumed remarks
3161313530 DS1977S40014C01 CO/SAT/400TC/114/IVORY 100 C16184204 100 100 SO qty

Spilt

3161313530 DS1977S40014C01 CO/SAT/400TC/114/IVORY 100 C16184206 100 100 SO qty

Spilt

3161313530 DS1977S40014C01 CO/SAT/400TC/114/IVORY 100 G15833208 100 100 SO qty

Spilt

3161313573 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150304 750 200 Batch qty

Spilt

3161313574 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150304 550 200 Batch qty

Spilt

3161313575 DS1977S40014C01 CO/SAT/400TC/114/IVORY 350 C16150304 350 350 Batch qty

Spilt

3161313576 DS1977S40014C01 CO/SAT/400TC/114/IVORY 250 C16151502 250 250 SO qty

Spilt

3161313576 DS1977S40014C01 CO/SAT/400TC/114/IVORY 250 C16151501 250 250 SO qty Spilt

3161313538 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150305 600 200 Batch qty

Spilt

3161313539 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150305 400 200 Batch qty

Spilt

3161313540 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150305 200 200 Batch qty

Spilt

Pls help on this..

Reply

A K Ojha
20 Sep, 18 at 6:13
pm

Sub SaveAs()

‘ SaveAs Macro

‘ Keyboard Shortcut: Ctrl+Shift+A

‘

ChDir “D:”
ActiveWorkbook.SaveAs Filename:= _

“D:gst Billing System2018.xlsm”, FileFormat:= _

xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

ChDir “E:JSM”

ActiveWorkbook.SaveAs Filename:=”E:JSMBilling System2018.xlsm”, FileFormat:= _

xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

Reply

Ram
19 Sep, 18 at 7:35
pm

Nice work

Reply

Jeffery
18 Sep, 18 at 11:49
am

Very well articulated, useful tool and helpful. We’ll done, excellent champ

Reply

T2
10 Sep, 18 at 4:39
pm

Thanks Puneet, nice work

Reply
 Jaimin Mistry
6 Sep, 18 at 2:26
am

How to run macro for collecting data from read only file?

Reply

PC
3 Sep, 18 at 2:47
pm

Thanks Puneet, this is so helpful

Need your help

Can you help create a macro for this instance in excel:

N/A

Abc

123

(Blank Cell)

XYZ

N/A
123-222

N/A

(Blank Cell)

Answer: Abc, 123, XYZ and 123-222

Thanks in advance

Reply

Puneet
6 Sep, 18 at 5:59
am
 Use power query for this. You need to have two steps, first remove errors and next,

combine the values from the range. Check out #4 point from here

https://excelchamps.com/blog/concatenate-a-range-of-cells/

Reply

Prasad M
24 Aug, 18 at 12:28
pm

Hey Hi,

Thanks for the codes.

I need your help to count the excel cell colors which used by conditional formatting. I had

tried many ways, but, no luck.

Kindly let me know, if you can help.

Reply

Raja
18 Aug, 18 at 8:23
am

Excellent would need your support

Reply

manish Chaurasiya
6 Aug, 18 at 8:12
pm

Thank you for sharing code in easier way, this is very helpful. I am just beginner in macro. I

have written a code to connect sql database but i m getting difficulty to connect more
than one database from different server.

Reply

Sally
30 Jul, 18 at 12:48
am

Great list! Thank you!

Reply

Puneet
3 Aug, 18 at 9:12
am

Thanks for your words.

Reply

loran shahin
26 Jul, 18 at 8:21
am

thank Puneet Gogia

Reply

Puneet
28 Jul, 18 at 6:05
pm

You are welcome. ?

 Reply

Guru
23 Jul, 18 at 4:50
am

Thanks Puneet, this is so helpful!

Reply

Puneet
23 Jul, 18 at 7:04
am

You are welcome.

Reply

Gideon
23 Jan, 18 at 10:31
am

Please I want the VBA code to merge multiple excel sheet in one. Can you send me the

code please.

Reply

Steven Brown
19 Jan, 18 at 3:15
pm
I’m getting a type mismatch when I run the ‘HighlightAlternateRows’ procedure. Debug

shows this line as the culprit:

‘rng.Value = rng ^ (1 / 3)’

Any help would be appreciated. Thanks

Reply

Steven Brown
22 Jan, 18 at 3:47
pm

I fixed it and it works!

Sub Highlight AlternateRows ()

Dim rng As Range

__For Each rng In Selection.Rows

____If rng.Row Mod 2 = 1 Then

____rng.Style = “20% – Accent1”

____Else

____End If

__Next rng

End Sub

(underscores added to show proper indenting)

Reply

Carlos Mario Castaño

3 Jan, 18 at 4:16 am

1. In Insert Multiple Rows please change the word “columns” by “rows” in

i = InputBox(“Enter number of columns to insert”, “Insert Columns”)

2. Closing Message

“You can use close_open to perform a task on opening a file. All you have to do just name

your macro

“close_open”.”
Sub auto_close()

The name of the macro is not “close_open”

3. Count/Highlight Cells With Error In Entire Worksheet

These statements must be in different lines:

i = i + 1 rng.Style = “bad”

4. In Count/Highlight Cells With A Specific In Entire Worksheet please add the word

“Value” after “Specific”

Reply

Carlos Mario Castaño

24 Dec, 17 at 10:42
pm

Although it worked for me, in the first Basic Macro, I have two observations:

1) I think that the For loop must be something like:

Dim j as integer

For j = 1 to i

ActiveCell.Value = j

ActiveCell.Offset(1, 0).Activate

Next j

that is, replace “i” by j in the index variable for the loop

2) As I said, your original code works but I think that the index variable must be different

to the inputbox variable.

Sincerely yours,

Carlos

Reply

Addison O'Conner
8 Dec, 17 at 5:55
pm

Hello! I would like a very specific code that I haven’t been able to find anywhere on the
internet…

I’m wanting the macro to identify blank cells in Row 1 only, delete the blank cells (in Row

1) & shift those columns’ cells up. Any advice??

Reply

Chris
10 Aug, 18 at 2:38
pm

Try this:

‘ DeleteBlankCellsinRow1 Macro

Sub DeleteBlankCellsinRow1()

Rows(“1:1”).Select

Selection.SpecialCells(xlCellTypeBlanks).Select

Selection.Delete Shift:=xlUp

End Sub

Reply

Ron007
7 Dec, 17 at 4:33
pm

Great list, but it would be nice if you made it easier for us to identify changes in it since

you say you make monthly changes.

Rather than a PDF, how about putting this tips in a downloadable spreadsheet or Word

document that the tips can be sorted by insertion date as well as category. Actually. If

you make the download cumulative that would be even better. So each month we could

replace the old file with the new one, containing the all of the tips you’ve published here

over time. Even if you start now building the cumulative file, that would be better.

Reply
 Puneet
8 Dec, 17 at 5:35
am

Thanks for the great advice.

Reply

S raw
29 Oct, 17 at 5:44
pm

Hello Sir,

I want to learn how to create macro. I have the basic knowledge of VB. Please advise from

where should I start.

Reply

Pravin Bhaiswar
12 Oct, 17 at 11:28
am

Sir, It’s extremely nice efforts. Would you save your precious time to modify one code of

you you did? I need it should ask us location to save ask us to rename the file name

before save………in the code for “Save Selected Range as a PDF” please modify this…..it

will be beneficial for all…….please send me to [email protected]

Reply

Puneet
12 Oct, 17 at 11:38
am
 Thanks you Pravin, for the correction. Will correct it soon,

Reply

Pravin Bhaiswar
12 Oct, 17 at 1:27
pm

Sir, I used this code at my office…it was nice working but on my home pc..it says “Run

time error 5: Invalid procedure call or argument…….So please have solution sir.

Reply

Puneet
13 Oct, 17 at 4:43
am

Which version of Microsoft Office you are using?

Reply

Pravin Bhaiswar
13 Oct, 17 at 7:55
am

Office 2007

Niharika Mehra
26 Sep, 17 at 3:58
pm

Hi.. Can someone help me with the vba code to apply filter in pivot table.
Reply

Khaja Raziuddin
24 Sep, 17 at 9:50
am

Hello, really nice to see all these. is there any macro to copy data from different file to

master file. if yes then can anyone please share

Reply

Puneet
24 Sep, 17 at 3:10
pm

You can use power query from that.

Reply

Colleen Armstrong
31 Aug, 17 at 3:00
am

Thank you for these!!! I am going to start putting many of the to use tomorrow!!

Reply

Puneet
31 Aug, 17 at 6:35
pm

That’s great.
 Reply

Himanshu Tiwari
30 Aug, 17 at 12:05
pm

Nice Work.
I was also trying to get in touch with you to understand if there is a way we can filter a

table based on unique values

Let’s say we have the following table on the meetings done by a person, and the start

time of each meeting

Date Start Time

———- ————–

Aug 24 9:00 AM

Aug 24 10:00 AM

Aug 24 1:45 PM

Aug 24 4:45 PM

Aug 25 8:00 AM

Aug 25 2:00 PM

Aug 25 5:00 PM

Aug 26 12:30 PM

Aug 26 2:00 PM

Aug 26 4:29 PM

Aug 26 8:28 PM

Now I need to calculate the average start time for the period (say week / month) from

such a table.

How to do so?

The best way I have right now is copy both the columns, and check for duplicates in the

Date column, followed by which I get to calculate the average start time. Something like

this.

Date Start Time

——— ——————-

Aug 24 9:00 AM

Aug 25 8:00 AM

Aug 26 12:30 PM

Can we build a formula to decrease the above task.

Reply

Dilshad Ahmad
30 Aug, 17 at 10:23
am

Awesome! Puneet !

Reply

Puneet
31 Aug, 17 at 6:35
pm

Thanks for your words.

Reply

Dhananjay Jadhav
30 Aug, 17 at 7:24
am

Great Puneet! Many of these are new & innovative for me. I am sure it will help me save

my hours of daily work. Thanks much

Reply

Puneet
31 Aug, 17 at 6:35
pm
 I’m so glad you liked it.

Reply

Hema Deepak Raturi

13 Aug, 17 at 3:38
am

How to transfer a cell value from main workbook to several workbooks via VBA program,

without opening the other several workbooks.

Reply

Puneet
13 Aug, 17 at 3:33
pm

will get back to you.

Reply

Jeff Faul
27 Jul, 17 at 2:50
pm

Hey, great macros. Question, I’m using macro 31 “add rows textbox” I’m adding rows at

line 35 and then I need to copy the formula from h34 down to all the new rows. Could you

help with this addition?

Reply
 Puneet
27 Jul, 17 at 5:33
pm

I assume you want to insert a new row and copy formula as well?

Reply

Jeff Faul
27 Jul, 17 at 10:33
pm

Yes, whatever number of rows are added I need the formula copied to every new row

Reply

Jeff Faul
30 Jul, 17 at 10:38
pm

Here is what I currently have:

Sub InsertMultipleRows()

Dim i As Integer

Dim j As Integer
Rows(“35:35”).Select

On Error GoTo Last

i = InputBox(“Enter number of items to add”, “Insert Items”)

For j = 1 To i

Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove

Next j

Last:

Range(“H34”).Select

Selection.AutoFill Destination:=Range(“H34:H35”), Type:=xlFillDefault

‘Range(“H34″+i).Select (This is the part I need help with)

Range(“C35”).Select
 Exit Sub

End Sub

Reply

Jeff Faul
5 Aug, 17 at 2:33
am

Nevermind, I figured it out

Reply

Puneet
5 Aug, 17 at 7:45
am

I’m sorry I just missed your update. Please share with me here so that other can

make use of it.

Kushal R Jaju
29 May, 17 at 6:56
am

Hi Puneet.. It’s a great website and I’m learning something every day. Thanks for that..

Save as PDF Command not working, can you please help. ?

Reply

Puneet
31 May, 17 at 10:21
am
 Please share the error you got.

Reply

mick
10 Apr, 19 at 8:20 am

hi Puneet, when saving to PDF I get the following error

Compile error: statement outside type block

the sentence “for each … Nextws” is shown in RED in 1 entire line

Sub SaveWorkshetAsPDF()

Dimws As Worksheet

For Each ws In Worksheetsws.ExportAsFixedFormat xlTypePDF, “ENTER-FOLDER-

NAME-HERE” & ws.Name & “.pdf” Nextws

End Sub

Reply

Venkateshwara Iyer
7 May, 17 at 3:28
am

i like to have the code to convert text to uppercase for entire sheet

Reply

Puneet
30 May, 17 at 10:57
am

updated

Reply
 balaji
11 Jul, 19 at 10:16 am

hi,

would u pls help how to perform vlookup in VBA

reg

Balaji

Reply

Venkateshwara Iyer
7 May, 17 at 3:28
am

SUPERB

Reply

Puneet
30 May, 17 at 2:14
pm

thank you

Reply

Vipul
1 Apr, 17 at 4:13
am
Great

Really helpful

Would like to see more VBA codes.

Thanks

Reply

Puneet
30 May, 17 at 10:58
am

updated new codes

Reply

vishesh
1 Mar, 17 at 5:14
am

Punit i am very novice to VB, so can you give some tips how to grow up in VB coding, your

kind guidance is required, my email id is [email protected]

Reply

Puneet
15 Mar, 17 at 8:21
am

Added.

Reply
 vishesh
1 Mar, 17 at 5:11
am

Thanks Punit for sharing Wonderful Excel tricks….Helped me to automate my few daily

routine task in one go….

Reply

Puneet
15 Mar, 17 at 8:21
am

I’m so glad you liked it.

Reply

gabriel gajardo
17 Feb, 17 at 4:03
pm

hi!

i work a lot with vba, a have some codes that can be useful, lake a parametric sendMail or

send a worksheet or range as body mail. if you wan to add the just get in touch.

by the way, thanks for share some codes.

Reply

Puneet
15 Mar, 17 at 8:22
am

Thank you, you can share with me.

Reply

zenix
7 Sep, 18 at 2:07
am

Thank you in advance for your generosity.

Reply

Abhiram G
6 Oct, 18 at 1:22
pm

hi Gabriel could you pls share this code to my mail ID also. [email protected] .

Thanks in advance

Reply

Rajan
17 Aug, 19 at 11:11 am

[email protected]

Reply

Rajan
17 Aug, 19 at 11:12 am

hi Gabriel could you pls share this code to my mail ID also. [email protected]
 Thanks in advance

Reply

ratanak
23 Mar, 16 at 2:02
am

Really nice,i’d love it.thanks puneet

Reply

Puneet
23 Mar, 16 at 6:09
am

Thanks Ratanak, For Your Words

Reply

Inet Kemp
21 Feb, 16 at 7:01
pm

nice…highlight active row and column

Reply

Puneet
3 Mar, 16 at 5:35
pm

Thanks Inet
Reply

Contact Terms Policy

© ExcelChamps 2020