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" to open the Visual Basic Editor.
- 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.
(List) Top 100 Macro Examples (CODES) for VBA Beginners
- This is my Ultimate VBA Library which I update on monthly basis with new codes and don't forget to check the VBA Examples Sectionꜜ at the end of this list.
- VBA is one of the Advanced Excel Skills.
- 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
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.
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.
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
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. 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.
Sub AutoFitColumns() Cells.Select Cells.EntireColumn.AutoFit End Sub
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.
Sub AutoFitRows() Cells.Select Cells.EntireRow.AutoFit End Sub
When you run this code, it will select all the cells in your worksheet and instantly auto fit all the rows.
6. Remove Text Wrap
This code will help you to remove text wrap from the entire worksheet with a single click.
Sub RemoveTextWrap() Range("A1").WrapText = False End Sub
It will first select all the columns and then remove text wrap and auto fit all the rows and columns. There’s also a shortcut that you can use (Alt + H +W) for but if you add this code to Quick Access Toolbar it’s convenient than a keyboard shortcut.
7. Unmerge Cells
This code simply uses the unmerge options which you have on the HOME tab.
Sub UnmergeCells() Selection.UnMerge End Sub
The benefit of using this code is you can add it to the QAT and unmerge all the cell in the selection. 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.
Sub DateInHeader() With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "&D" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" End With End Sub
You can also change it to the footer or change the side by replacing the "" with the date tag. 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
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
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.
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.
Formatting Codes
These VBA codes will help you to format cells and ranges using some specific criteria and conditions.
11. Highlight Duplicates from Selection
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
This macro will check each cell of your selection and highlight the duplicate values. You can also change the color from the code.
12. Highlight the Active Row and Column
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
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.
- Open VBE (ALT + F11).
- Go to Project Explorer (Ctrl + R, If hidden).
- Select your workbook & double click on the name of a particular worksheet in which you want to activate the macro.
- Paste the code into it and select the “BeforeDoubleClick” from event drop down menu.
- Close VBE and you are done.
Remember that, by applying this macro you will not able to edit the cell by double click.
13. Highlight Top 10 Values
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
Just select a range and run this macro and it will highlight top 10 values with the green color.
14. Highlight Named Ranges
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
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.
15. Highlight Greater than 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
Once you run this code it will ask you for the value from which you want to highlight all greater values.
16. Highlight Lower Than Values
Sub HighlightLowerThanValues() 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
Once you run this code it will ask you for the value from which you want to highlight all lower values.
17. Highlight Negative Numbers
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
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.
18. Highlight Specific Text
Sub highlightValue() Dim myStr As String Dim myRg As range Dim myTxt As String Dim myCell As range 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" GoTo LInput 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
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.
19. Highlight Cells with Comments
Sub highlightCommentCells() Selection.SpecialCells(xlCellTypeComments).Select Selection.Style= "Note" End Sub
To highlight all the cells with comments use this macro.
20. Highlight Alternate Rows in the Selection
Sub highlightAlternateRows() Dim rng As Range For Each rng In Selection.Rows If rng.Row Mod 2 = 1 Then rng.Style = "20% -Accent1" rng.Value = rng ^ (1 / 3) Else End If Next rng End Sub
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.
21. Highlight Cells with Misspelled Words
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
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.
22. Highlight Cells With Error in the Entire Worksheet
Sub highlightErrors() Dim rng As Range Dim i As Integer 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
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.
23. Highlight Cells with a Specific Text in Worksheet
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
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.
24. Highlight all the Blank Cells Invisible Space
Sub blankWithSpace() Dim rng As Range For Each rng In ActiveSheet.UsedRange If rng.Value = " " Then rng.Style = "Note" End If Next rng End Sub
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.
25. Highlight Max Value In The Range
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
It will check all the selected cells and highlight the cell with the maximum value.
26. Highlight Min Value In The Range
Sub Highlight_Min_Value() Dim rng As Range For Each rng In Selection If rng = WorksheetFunction.Min(Selection) Then rng.Style = "Good" End If Next rng End Sub
It will check all the selected cells and highlight the cell with the Minimum value.
27. Highlight Unique Values
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
This codes will highlight all the cells from the selection which has a unique value.
28. Highlight Difference in Columns
Sub columnDifference() Range("H7:H8,I7:I8").Select Selection.ColumnDifferences(ActiveCell).Select Selection.Style= "Bad" End Sub
Using this code you can highlight the difference between two columns (corresponding cells).
29. Highlight Difference in Rows
Sub rowDifference() Range("H7:H8,I7:I8").Select Selection.RowDifferences(ActiveCell).Select Selection.Style= "Bad" End Sub
And by using this code you can highlight difference between two row (corresponding cells).
Printing Codes
30. Print Comments
Sub printComments() With ActiveSheet.PageSetup .printComments = xlPrintSheetEnd End With End Sub
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.
31. Print Narrow Margin
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.PrintOut _ Copies:=1, _ Collate:=True, _ IgnorePrintAreas:=False End Sub
Use this VBA code to take a print with a narrow margin. When you run this macro it will automatically change margins to narrow.
32. Print Selection
Sub printSelection() Selection.PrintOut Copies:=1, Collate:=True End Sub
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.
33. Print Custom Pages
Sub printCustomSelection() Dim startpage As Integer Dim endpage As 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.PrintOut From:=startpage, _ To:=endpage, Copies:=1, Collate:=True End Sub
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.
Worksheet Codes
34. Hide all but the Active Worksheet
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
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.
Related: VBA Functions List
35. Unhide all Hidden Worksheets
Sub UnhideAllWorksheet() Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets ws.Visible = xlSheetVisible Next ws End Sub
And if you want to un-hide all the worksheets which you have hide with previous code, here is the code for that.
36. Delete all but the Active Worksheet
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
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.
37. Protect all Worksheets Instantly
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
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.
38. Resize All Charts in a Worksheet
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
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.
39. Insert Multiple Worksheets
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
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.
40. Protect Worksheet
Sub ProtectWS() ActiveSheet.Protect "mypassword", True, True End Sub
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.
41. Un-Protect Worksheet
Sub UnprotectWS() ActiveSheet.Unprotect "mypassword" End Sub
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.
42. Sort Worksheets
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
This code will help you to sort worksheets in your workbook according to their name.
43. Protect all the Cells With Formulas
Sub lockCellsWithFormulas() With ActiveSheet .Unprotect .Cells.Locked = False .Cells.SpecialCells(xlCellTypeFormulas).Locked = True .Protect AllowDeletingRows:=True End With End Sub
To protect cell with formula with a single click you can use this code.
44. Delete all Blank Worksheets
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
Run this code and it will check all the worksheets in the active workbook and delete if a worksheet is blank.
45. Unhide all Rows and Columns
Sub UnhideRowsColumns() Columns.EntireColumn.Hidden = False Rows.EntireRow.Hidden = False End Sub
Instead of unhiding rows and columns on by one manually you can use this code to do this in a single go.
46. Save Each Worksheet as a Single PDF
Sub SaveWorkshetAsPDF() Dimws As Worksheet For Each ws In Worksheets ws.ExportAsFixedFormat _ xlTypePDF, _ "ENTER-FOLDER-NAME-HERE" & _ ws.Name & ".pdf" Next ws End Sub
This code will simply save all the worksheets in a separate PDF file. You just need to change the folder name from the code.
47. Disable Page Breaks
Sub DisablePageBreaks() Dim wb As Workbook Dim wks As Worksheet Application.ScreenUpdating = False For Each wb In Application.Workbooks For Each Sht In wb.Worksheets Sht.DisplayPageBreaks = False Next Sht Next wb Application.ScreenUpdating = True End Sub
To disable page breaks use this code. It will simply disable page breaks from all the open workbooks.
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
Sub FileBackUp() ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & _ "" & Format(Date, "mm-dd-yy") & " " & _ ThisWorkbook.name End Sub
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.
49. Close all Workbooks at Once
Sub CloseAllWorkbooks() Dim wbs As Workbook For Each wbs In Workbooks wbs.Close SaveChanges:=True Next wb End Sub
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.
50. Copy Active Worksheet into a New Workbook
Sub CopyWorksheetToNewWorkbook() ThisWorkbook.ActiveSheet.Copy _ Before:=Workbooks.Add.Worksheets(1) End Sub
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.
51. Active Workbook in an Email
Sub Send_Mail() Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .to = "Sales@FrontLinePaper.com" .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
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".
52. Add Workbook to a Mail Attachment
Sub OpenWorkbookAsAttachment() Application.Dialogs(xlDialogSendMail).Show End Sub
Once you run this macro it will open your default mail client and attached active workbook with it as an attachment.
53. Welcome Message
Sub auto_open() MsgBox _ "Welcome To ExcelChamps & Thanks for downloading this file." End Sub
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".
54. Closing Message
Sub auto_close() MsgBox "Bye Bye! Don't forget to check other cool stuff on excelchamps.com" End Sub
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".
55. Count Open Unsaved Workbooks
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
Let’s you have 5-10 open workbooks, you can use this code to get the number of workbooks which are not saved yet.
Pivot Table Codes
56. Hide Pivot Table Subtotals
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) = False Next pf End Sub
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.
57. Refresh All Pivot Tables
Sub vba_referesh_all_pivots() Dim pt As PivotTable For Each pt In ActiveWorkbook.PivotTables pt.RefreshTable Next pt End Sub
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.
58. Create a Pivot Table
Follow this step-by-step guide to create a pivot table using VBA.
59. Auto 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 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
If you are not using Excel tables then you can use this code to update pivot table range.
60. Disable/Enable Get Pivot Data
Sub activateGetPivotData() Application.GenerateGetPivotData = True End Sub Sub deactivateGetPivotData() Application.GenerateGetPivotData = False End Sub
To disable/enable GetPivotData function you need to use Excel option. But with this code you can do it in a single click.
Charts Codes
61. Change Chart Type
Sub ChangeChartType() ActiveChart.ChartType = xlColumnClustered End Sub
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.
62. Paste Chart as an Image
Sub ConvertChartToPicture() ActiveChart.ChartArea.Copy ActiveSheet.Range("A1").Select ActiveSheet.Pictures.Paste.Select End Sub
This code will help you to convert your chart into an image. You just need to select your chart and run this code.
63. Add 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
First of all, you need to select your chart and the run this code. You will get an input box to enter chart title.
Advanced Codes
64. Save Selected Range as a PDF
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) = False Next pf End Sub
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.
65. Create a Table of Content
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
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.
66. Convert Range into an Image
Sub PasteAsPicture() Application.CutCopyMode = False Selection.Copy ActiveSheet.Pictures.Paste.Select End Sub
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.
67. Insert a Linked Picture
Sub LinkedPicture() Selection.Copy ActiveSheet.Pictures.Paste(Link:=True).Select End Sub
This VBA code will convert your selected range into a linked picture and you can use that image anywhere you want.
68. Use Text to Speech
Sub Speak() Selection.Speak End Sub
Just select a range and run this code. Excel will speak all the text what you have in that range, cell by cell.
69. Activate Data Entry Form
Sub DataForm() ActiveSheet.ShowDataForm End Sub
There is a default data entry form which you can use for data entry.
70. Use Goal Seek
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
Goal Seek can be super helpful for you to solve complex problems. Learn more about goal seek from here before you use this code.
71. 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
72. Convert all Formulas into 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 Next MyCell End Sub
Simply convert formulas into values. When you run this macro it will quickly change the formulas into absolute values.
73. Remove Spaces from Selected Cells
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
One of the most useful macros from this list. It will check your selection and then remove all the extra spaces from that.
74. Remove Characters from a String
Public Function removeFirstC(rng As String, cnt As Long) removeFirstC = Right(rng, Len(rng) - cnt) End Function
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.
75. Add Insert Degree Symbol in Excel
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
Let’s say you have a list of numbers in a column and you want to add degree symbol with all of them.
76. Reverse Text
Public Function rvrse(ByVal cell As Range) As String rvrse = VBA.strReverse(cell.Value) End Function
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.
77. Activate R1C1 Reference Style
Sub ActivateR1C1() If Application.ReferenceStyle = xlA1 Then Application.ReferenceStyle = xlR1C1 Else Application.ReferenceStyle = xlR1C1 End If End Sub
This macro code will help you to activate R1C1 reference style without using Excel options.
78. Activate A1 Reference Style
Sub ActivateA1() If Application.ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlA1 Else Application.ReferenceStyle = xlA1 End If End Sub
This macro code will help you to activate A1 reference style without using Excel options.
79. Insert Time Range
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
With this code, you can insert a time range in sequence from 00:00 to 23:00.
80. Convert Date into Day
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 End Sub
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.
81. Convert Date into Year
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
This code will convert dates into years.
82. Remove Time from Date
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
If you have time with the date and you want to remove it then you can use this code.
83. Remove Date from Date and Time
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
It will return only time from a date and time value.
84. Convert to Upper Case
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
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.
85. Convert to Lower Case
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
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.
86. Convert to Proper Case
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
And this code will convert selected text into the proper case where you have the first letter in capital and rest in small.
87. Convert to 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
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.
88. Remove a Character from Selection
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 End Sub
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.
89. Word Count from Entire 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
It can help you to count all the words from a worksheet.
90. Remove the Apostrophe from a Number
Sub removeApostrophes() Selection.Value = Selection.Value End Sub
If you have numeric data where you have an apostrophe before each number, you run this code to remove it.
91. Remove Decimals from Numbers
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
This code will simply help you to remove all the decimals from the numbers from the selected range.
92. Multiply all the Values by a Number
Sub addNumber() Dim rng As Range Dim i As Integer i = InputBox("Enter number to multiple", "Input Required") For Each rng In Selection If WorksheetFunction.IsNumber(rng) Then rng.Value = rng + i Else End If Next rng End Sub
Let’s you have a list of numbers and you want to multiply all the number with a particular. To 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.
93. Add a Number in all the Numbers
Sub addNumber() Dim rng As Range Dim i As Integer i = InputBox("Enter number to multiple", "Input Required") For Each rng In Selection If WorksheetFunction.IsNumber(rng) Then rng.Value = rng + i Else End If Next rng End Sub
Just like multiplying you can also add a number into a set of numbers.
94. Calculate the Square Root
Sub getSquareRoot() Dim rng As 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
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.
95. Calculate the 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
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.
96. Add A-Z Alphabets in a Range
Sub addsAlphabets1() Dim i As Integer For i = 65 To 90 ActiveCell.Value = Chr(i) ActiveCell.Offset(1, 0).Select Next i End Sub
Sub addsAlphabets2() Dim i As Integer For i = 97 To 122 ActiveCell.Value = Chr(i) ActiveCell.Offset(1, 0).Select Next i End Sub
Just like serial numbers you can also insert alphabets in your worksheet. Beloware the code which you can use.
97. 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
Sometimes it’s really hard to understand Roman numbers as serial numbers. This code will help you to convert roman numbers into Arabic numbers.
98. Remove Negative Signs
Sub removeNegativeSign() Dim rng As Range Selection.Value = Selection.Value For Each rng In Selection If WorksheetFunction.IsNumber(rng) Then rng.Value = Abs(rng) End If Next rng
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.
99. Replace Blank Cells with Zeros
Sub replaceBlankWithZero() Dim rng As Range Selection.Value = Selection.Value For Each rng In Selection If rng = "" Or rng = " " Then rng.Value = "0" Else End If Next rng End Sub
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.
- Create a User Defined Function [UDF] in Excel using VBA
- VBA Interview Questions
- Add a Comment in a VBA Code (Macro)
- Add a Line Break in a VBA Code (Single Line into Several Lines)
- Add a New Line (Carriage Return) in a String in VBA
- Record a Macro in Excel
- VBA Exit Sub Statement
- VBA Immediate Window (Debug.Print)
- VBA Module
- VBA Objects
- VBA With
- Add Developer Tab on Excel Ribbon | Windows + Mac
- Count Rows using VBA in Excel
- Excel VBA Font (Color, Size, Type, and Bold)
- Excel VBA Hide and Unhide a Column or a Row
- Excel VBA Range – Working with Range and Cells in VBA
- Apply Borders on a Cell using VBA in Excel
- Find Last Row, Column, and Cell using VBA in Excel
- Insert a Row using VBA in Excel
- Merge Cells in Excel using a VBA Code
- Select a Range/Cell using VBA in Excel
- SELECT ALL the Cells in a Worksheet using a VBA Code
- ActiveCell in VBA in Excel
- Special Cells Method in VBA in Excel
- UsedRange Property in VBA in Excel
- VBA AutoFit (Rows, Column, or the Entire Worksheet)
- VBA ClearContents (from a Cell, Range, or Entire Worksheet)
- VBA Copy Range to Another Sheet + Workbook
- VBA Enter Value in a Cell (Set, Get and Change)
- VBA Insert Column (Single and Multiple)
- VBA Named Range | (Static + from Selection + Dynamic)
- VBA Range Offset
- VBA Sort Range | (Descending, Multiple Columns, Sort Orientation
- VBA Wrap Text (Cell, Range, and Entire Worksheet)
- Extract Hyperlink Address (URL) VBA
- CLEAR an Entire Sheet using VBA in Excel
- Copy and Move a Sheet in Excel using VBA
- COUNT Sheets using VBA in Excel
- DELETE a SHEET using VBA in Excel
- Hide & Unhide a Sheet using VBA in Excel
- PROTECT and UNPROTECT a Sheet using VBA in Excel
- RENAME a Sheet using VBA in Excel
- Write a VBA Code to Create a New Sheet in Excel (Macro)
- VBA Worksheet Object -Working with Excel Worksheet in VBA
- Activate a Sheet using VBA
- Copy an Excel File (Workbook) using VBA – Macro Code
- VBA Activate Workbook (Excel File)
- VBA Close Workbook (Excel File)
- VBA Combine Workbooks (Excel Files)
- VBA Create New Workbook (Excel File)
- VBA Delete Workbook (Excel File)
- VBA Open Workbook (Excel File)
- VBA Protect/Unprotect Workbook (Excel File)
- VBA Rename Workbook (Excel File)
- VBA Save Workbook (Excel File)
- VBA ThisWorkbook (Current Excel File)
- VBA Workbook – A Guide to Work with Workbooks in VBA
- Declare Global Variable (Public) in VBA
- Use a Range or a Cell as a Variable in VBA
- Option Explicit Statement in VBA
- Variable in a Message Box
- VBA Constants
- VBA Dim Statement
- VBA Variables (Declare, Data Types, and Scope)
- VBA Add New Value to the Array
- VBA Array
- VBA Array Length (Size)
- VBA Array with Strings
- VBA Clear Array (Erase)
- VBA Dynamic Array
- VBA Loop Through an Array
- VBA Multi-Dimensional Array
- VBA Range to an Array
- VBA Search for a Value in an Array
- VBA Sort Array
- Average Values in Excel using VBA
- Get Today’s Date and Current Time using VBA
- Sum Values in Excel using VBA
- Match Function in VBA
- MOD in VBA
- Random Number
- VBA Calculate (Cell, Range, Row, & Workbook)
- VBA Concatenate
- VBA Worksheet Function (Use Excel Functions in a Macro)
- VBA Check IF a Sheet Exists
- VBA Check IF a Cell is Empty + Multiple Cells
- VBA Check IF a Workbook Exists in a Folder (Excel File)
- VBA Check IF a Workbook is Open (Excel File)
- VBA Exit IF
- VBA IF – IF Then Else Statement
- VBA IF And (Test Multiple Conditions)
- VBA IF Not
- VBA IF OR (Test Multiple Conditions)
- VBA Nested IF
- VBA Select Case
- VBA Automation Error (Error 440)
- VBA Error 400
- VBA ERROR Handling
- VBA Invalid Procedure Call Or Argument Error (Error 5)
- VBA Object Doesn’t Support this Property or Method Error (Error 438)
- VBA Object Required Error (Error 424)
- VBA Out of Memory Error (Error 7)
- VBA Overflow Error (Error 6)
- VBA Runtime Error (Error 1004)
- VBA Subscript Out of Range Runtime Error (Error 9)
- VBA Type Mismatch Error (Error 13)
- Excel VBA Do While Loop and (Do Loop While) – A Guide
- Loop Through All the Sheets using VBA in Excel
- Loop Through a Range using VBA (Columns, Row, and UsedRange)
- VBA FOR LOOP (For Next, For Each) – The Guide + Examples
- VBA GoTo Statement
- VBA Loops (Beginner to Advanced) – A Guide
- Input Box in VBA
- VBA Create and Write to a Text File
- VBA ScreenUpdating
- VBA Status Bar (Hide, Show, and Progress)
- VBA Wait and Sleep Commands to Pause and Delay
- Save an Excel Macro-Enabled Workbook (.xlsm File Type)
- Search on Google using a VBA
Author: Puneet Gogia
Hi. I’m a new old man programmer. Why on some code i have ‘Sub or Function not define’ with tFirstPriority?
I’ve tried so many different things, but I can’t seem to get what I’m looking for.
My scenario:
In one sheet, I have names in 5 different columns (A,D,G,J,M). In the columns to the right of the names (B,E,H,K,L), a selection is made from a drop down list.
What I want to do: in different sheets, paste the names in a specific location based on the selection made from the drop down.
Is this something you could help me with?
How to copy data from word document and later from Excel sheet for mail body to Outlook mail via Excel macro
Hi
Can a user save an Excel sheet as useable PDF with these specific requirements (header / footer on every page, column descriptor on every page, formatted to landscape with multiple columns on each) and still be legible for the user? Doesn’t seem possible to me.
Any suggestions?
Thank you
Hi All Please Help Me To Solve My Below Problem
Daily I am finding multiple files from a specific folder and moving them to another folder one by one can anyone help me by providing an Excel macro where I can mention the files name and it will find and copy the file from the existing folder and paste to the specific folder it will save my 1 to 1n half hours daily by finding and doing a copy paste of multiple files
Perfect ,,, realy
I ended up here because I’m looking for a special code.
for a ow
there are examples of it.
but,,
what you have done here is great.
Hello , i have a problem,
How i can tell excel (VBA code) to add +4 each time inside R[ ]. By that i mean R[4] +4 =R[8]. I want it to add +4 each time from the last calculate. i want 1000 calculates!
The code is :
sub ()
Range(“B129”).Select
ActiveCell.FormulaR1C1=
“IF(SUM(documents!R[375]C[12]:R[378]C[12])>0.001,SUM(documents!R[375]C[12]:R[378]C[12]),””””)”
can you pls provide a macro to pickup and consolidate excel file?
how to macro enable tool /utilty
https://excelchamps.com/blog/merge-excel-files-one-workbook/
https://excelchamps.com/worksheet/consolidate/
good afternoon
this code does not work for me
6. Remove Text Wrap
Sub RemoveTextWrap()
Range(“A1”).WrapText = False
End Sub
Could somebody help me create a macro script for the following routine.
I have a survey form send to various survey respondents which is now completed and I have already exported it as an Excel File. This imported survey data has 6 (Six) options (1, 2, 3, 4, 5, and N/A) for each survey question. Lets say, I have 5 respondents for each survey. So each respondent will select their option out of these six options, which I am going to show in separate colors in Agenda Sheet (Excel file) where I need to run this requested code/script.
Against, each question I have 7 cells – The first sex cells for the options; and the 7th cell for the consensus choice. All cells are with “No Fill – White” initially. When I double click each of these 7 cells – I would like to see the following:
Cell 1: Initial (White); When double clicked (Red)
Cell 2: Initial (White); When double clicked (Yellow)
Cell 3: Initial (White); When double clicked (Grey)
Cell 4: Initial (White); When double clicked (Green)
Cell 5: Initial (White); When double clicked (Fluorescent Green)
Cell N/A: Initial (White); When double clicked (stay White)
Any help would be appreciated in this regard.
Thanks in advance
V.
Puneetji, Sincere thanks for such an elaborate info and workings on Macro , VBA CODES.
Please tell me how can I download PDF of all these 100 VBA codes. I am an individual and I don’t have any website.
Wellcome Mr. Puneet.
Your webpage is very very interesting and away some. It will help new learners.
Thanks.
A helpful set of Subs and I was able to leverage “65. Create a Table of Content”. I found one issue in the code when you referenced the current workbook as “ThisWordbook” rather than “ActiveWorkbook”. In my case, I had 2 workbooks open and the original Sub code interacted with both open workbooks – not just the active one. Changing references in the code from “ThisWorkbook” to “ActiveWorkbook” restricted the sub to the single active workbook and eliminated runTime errors that I was encountering. It appears that you may want to consider this change for other Subs that use “This..” rather than “Active…” for workbook references since you are usually intending only to interact with a single [active] workbook. Thank you for putting this together.
Is there a code to apply different themes to each individual sheet? Each time I apply a theme it updates the entire workbook to that theme.
I was wondering if there was a macro that could automatically update a sheet to its desired theme when clicked?
Do you have a book with all these VBA codes?
Is it possible to set up an Email notification to go out to a group of people, when information is changed or added to a certain column in Excel?
Is there a VBA Code that I can make or use to send an email when Column L has new information added or when old information was changed?
I am very impressed. I have gotten code from the internet before, and I don’t remember a time when anything worked without at least some massaging. The Table of Contents intrigued me. I tried it and it worked right out of the box. Well done.
Dear David
Really thank you for your sharing. If I have chanced, I want to learn VBA coding from you.
I am not an Excel Expert, but I need a VBA.
I think you could code it for me.
I don’t know your e-mail to ask you.
Please, send me an e-mail.
Thank you so much!
Hi Puneet,
I am not able to run this code it giving me an error of “Variable required. Can’t assign to this expression”
Sub highlightValue()
Dim myStr As String
Dim myRg As Range
Dim myTxt As String
Dim myCell As Range
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”
GoTo LInput
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
can you help me on this
Hi
Thanks for maintaining this site . A great help for beginners like us. I want a help on list box control. A small subroutine to select data from a single column listbox and put the data in a cell for using the same in a formula or another subroutine. Can you provide a sample of 4 rows single column list box ?
Regards
How can I put 28 excel sheet to one workbook to separate tabs?
Sheets.Add Count:=28
Sub Combine()
‘UpdatebyExtendoffice
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = “Combined”
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
this code is not working
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
Hi sir , I used VBA code in word file for mail-merge. In this VBA i prepared 10 increment letter of employees in PDF file.
Now I want a VBA CODE in which i will protect these PDF files with with a unique password for each employee increment latter and then send this protected PDF file to each employee on his email address.
Can you provide me VBA Code for it. Waiting For your cool response Thanks in advance
Hi
I’ve just started learning programing with VBA and I was wondering how I can create a specific MACRO.
The macro I’d hope to create should have the function that it automatically merges cells once the cell height exceeds it’s maximum height of 409 due to large data being put into it.
Could you assist me on this please?
Kind regards
Hi
Dear Puneet
I am new in VBA programing
I need your help in making a little program.
I have a list of 10 angles in a column in excel worksheet.
First of all I have to find out the sin of those angles in the next column.
Then, divide those values by the minimum of them.
What will be the code?
Thanking you in advance.
Regards
Great info. You put a lot of time into this. Unfortunately, it does not cover what I am trying to do. Do you have a code for the following scenario?
I have a spreadsheet that contains 100 rows. Each row has multiple columns of data. I would like to take data from each row – one row at a time and copy into another spreadsheet. This spreadsheet is designed to look like a report. I am able to do this with my current level of knowledge. I will need to do this for each row of data – thus, I will need to do this 100x. I have created a recorded macro that will take each cell from the 1st row and place it in the proper place on the “report spreadsheet” and then print the spreadsheet. I need to do this for each row though. I actually spent the afternoon recording a macro where I went through and did this individually with each row (100 times). When I tried to run the macro, it said it was too big. Ugh… all that work for nothing. I have read about looping, but was not sure how to code that. I was hoping that I could add a looping code to the first original macro that takes info from row 1 of spreadsheet1 and pastes it into the proper cells on spreadsheet2 (report spreadsheet) and then prints it. Is this possible or will it be too big as well? Thank you in advance for your help.
I’m looking for a similar process too!
Hi
you can try this code..collected from another website.
Sub makepdf()
Dim rng As Range
Dim i As Integer
Dim wkb As Workbook
Set rng = Sheet2.Range(“A1:A” & Sheet2.Cells(Rows.Count, “A”).End(xlUp).Row)
For i = 2 To Sheet2.Cells(Rows.Count, “A”).End(xlUp).Row
Sheet1.Range(“b4”) = Sheet2.Range(“B” & i)
Sheet1.Range(“b5”) = Sheet2.Range(“c” & i)
Sheet1.Range(“b6”) = Sheet2.Range(“d” & i)
Sheet1.Range(“b7”) = Sheet2.Range(“e” & i)
Sheet1.Range(“b8”) = Sheet2.Range(“f” & i)
Sheet1.Range(“b9”) = Sheet2.Range(“g” & i)
Sheet1.Range(“b10”) = Sheet2.Range(“i” & i)
Sheet1.Range(“b11”) = Sheet2.Range(“p” & i)
Sheet1.Range(“c3”) = Sheet2.Range(“r” & i)
Sheet1.Range(“d4”) = Sheet2.Range(“h” & i)
Sheet1.Range(“d5”) = Sheet2.Range(“j” & i)
Sheet1.Range(“d6”) = Sheet2.Range(“k” & i)
Sheet1.Range(“d7”) = Sheet2.Range(“m” & i)
Sheet1.Range(“d8”) = Sheet2.Range(“n” & i)
Sheet1.Range(“d9”) = Sheet2.Range(“o” & i)
Sheet1.Range(“d11”) = Sheet2.Range(“q” & i)
Sheet1.Range(“b13”) = Sheet2.Range(“l” & i)
Worksheets(1).Activate
ChDir “C:\Users\91971\Desktop\Salary Slip”
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
“C:\Users\91971\Desktop\Salary Slip\” & Sheet2.Range(“B” & i) & “-” & Sheet2.Range(“C” & i) & “-” & Application.WorksheetFunction.Text(Sheet2.Range(“R” & i), “MMM-YYYY”) & “.pdf”, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next i
MsgBox ” All Salary Slip Has Been Generated, Please check Forlder”
End Sub
Thanks
You will need to look into For each … next formulas.
It basically creates a loop.
I’m also new, but there’s lots out there on this topic.
Hello and thankyou for all the information!! I am trying to create a table and autofit column width on the body of the table, not the headers.
Here are some shorter alternates for a few of the macros you posted…
‘1. Add Serial Numbers
Sub AddSerialNumbers()
Dim X As Variant
X = InputBox(“Enter Value”, “Enter Serial Numbers”)
If Len(X) > 0 And Not X Like “*[!0-9]*” Then
ActiveCell.Resize(X) = Evaluate(“ROW(1:” & X & “)”)
End If
End Sub
’12. Highlight the Active Row and Column
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Union(Target.EntireColumn, Target.EntireRow).Select
End Sub
’17. Highlight Negative Numbers
Sub highlightNegativeNumbers()
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Font.Color = vbRed
Selection.Replace “-*”, “”, xlWhole, SearchFormat:=False, ReplaceFormat:=True
Application.ReplaceFormat.Clear
End Sub
’22. Highlight Cells With Error in the Entire Worksheet
Sub highlightErrors()
With Cells.SpecialCells(xlFormulas, xlErrors)
.Style = “Bad”
MsgBox “Total errors on worksheet: ” & .Count
End With
End Sub
’24. Highlight all the Blank Cells Invisible Space
Sub blankWithSpace()
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Interior.ColorIndex = 40
ActiveSheet.UsedRange.Replace ” “, “”, xlWhole, SearchFormat:=False, ReplaceFormat:=True
Application.ReplaceFormat.Clear
End Sub
I’m trying to transliterate a excel document which has greek letters. I’d tried to write a macro, but failed.
This macro was suppose to change the greek alpha character to an ‘a’
But is does not like the Unichar function I tried to use. Yes, I know very little about excel macros
Sub Macro3()
‘
‘ Macro3 Macro
‘
‘
Cells.Replace What:=Unichar(945), Replacement:=”a”, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
, FormulaVersion:=xlReplaceFormula2
End Sub
Hello,
Your codes are really useful.
I found that your .SetFirstPriority isn’t showing up fully that’s why when I copy and paste it errored out “sub not defined”.
Thank you!
Hello I’m new to macros and have the basic principle of how to use them, but code writing is not a strong point for me. What I would like to do is create a button in excel so when I open my sheet to pay the next invoice I can click this button and the totals in column “G”, copy over to column “I” but when they copy from “G” to “I” the totals keep adding up in “I”.
I hope this makes sense…can anyone help?
Hi guys I’m new to this group. I have the data that will be printed by entering Id.no. in the specific cell. Then I will printed it and insert the next ID. Then print, enter the next ID. Then, print, ID, Print,…. When I write the ID, the course result has been changed. This is my question.
Is there any code that will do insert sequential ID number to that cell and print sequentially. In addition that can I specify the number “1-12” or “1-20” by using user input box?
Thanks in advance.
Hello guys thanks..i wanted to undestnad below codes can someone pls help for declaration part
Private Declare PtrSafe Function SetCursorPos Lib “user32” (ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Sub mouse_event Lib “user32” (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Private Const MOUSEEVENTF_RIGHTUP As Long = &H10
Declare PtrSafe Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
Sub MouseMove()
Dim lngCurPos As POINTAPI
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim MinutesElapsed As String
StartTime = Timer
StartTime1 = Timer
GetCursorPos lngCurPos
x2 = lngCurPos.x
y2 = lngCurPos.y
Worksheets(“Sheet1”).Range(“B1:B6”).Value = “”
Worksheets(“Sheet1”).Range(“A1”).Value = “Cursor Position”
Worksheets(“Sheet1”).Range(“A2”).Value = “Time Elapsed”
Worksheets(“Sheet1”).Range(“A3”).Value = “Seconds Elapsed”
Worksheets(“Sheet1”).Range(“A4”).Value = “Time Remaining”
Worksheets(“Sheet1”).Range(“A5”).Value = “Times Activated”
Worksheets(“Sheet1”).Range(“A6”).Value = “Total Run Time”
Worksheets(“Sheet1”).Range(“A7”).Value = “Time to Activate”
Worksheets(“Sheet1”).Range(“B4”).Interior.ColorIndex = xlNone
Worksheets(“Sheet1”).Range(“B7”).Interior.ColorIndex = 6
Worksheets(“Sheet1”).Range(“A1:B7”).Borders.LineStyle = xlContinuous
Worksheets(“Sheet1”).Columns(“A”).ColumnWidth = 21
Worksheets(“Sheet1”).Columns(“B”).ColumnWidth = 15
Worksheets(“Sheet1”).Columns(“B”).HorizontalAlignment = xlCenter
If Worksheets(“Sheet1”).Range(“B7”).Value = “” Then
Worksheets(“Sheet1”).Range(“B7”).Value = “12:01:00 AM”
End If
Worksheets(“Sheet1”).Range(“B7”).NumberFormat = “hh:mm:ss”
SecondsToActivate = Worksheets(“Sheet1”).Range(“B7”).Value
SecondsToActivate = Hour(SecondsToActivate) * 3600 + Minute(SecondsToActivate) * 60 + Second(SecondsToActivate)
counter = 0
Do
DoEvents
GetCursorPos lngCurPos
x1 = lngCurPos.x
y1 = lngCurPos.y
If x1 x2 Or y1 y2 Then
StartTime = Timer
Worksheets(“Sheet1”).Range(“B4”).Interior.ColorIndex = xlNone
End If
SecondsElapsed = Round(Timer – StartTime, 2)
MinutesElapsed = Format(((Timer – StartTime) – 0.5) / 86400, “hh:mm:ss”)
Worksheets(“Sheet1”).Range(“B1”).Value = “X: ” & lngCurPos.x & ” Y: ” & lngCurPos.y
Worksheets(“Sheet1”).Range(“B2”).Value = MinutesElapsed
Worksheets(“Sheet1”).Range(“B3”).Value = SecondsElapsed
Worksheets(“Sheet1”).Range(“B4”).Value = Format(((SecondsToActivate – SecondsElapsed) + 0.5) / 86400, “hh:mm:ss”)
Worksheets(“Sheet1”).Range(“B5”).Value = counter
Worksheets(“Sheet1”).Range(“B6”).Value = Format(((Timer – StartTime1) – 0.5) / 86400, “hh:mm:ss”)
If SecondsElapsed = SecondsToActivate * 0.7 And SecondsElapsed = SecondsToActivate * 0.8 And SecondsElapsed = SecondsToActivate * 0.9 And SecondsElapsed = SecondsToActivate * 0.95 Then
If SecondsElapsed Mod 2 = 0 Then
Worksheets(“Sheet1”).Range(“B4”).Interior.ColorIndex = xlNone
Worksheets(“Sheet1”).Range(“B4”).Font.Color = RGB(255, 0, 0)
ElseIf SecondsElapsed Mod 2 0 Then
Worksheets(“Sheet1”).Range(“B4”).Interior.ColorIndex = 3
Worksheets(“Sheet1”).Range(“B4”).Font.Color = RGB(255, 255, 255)
End If
End If
If SecondsElapsed >= SecondsToActivate Then
Worksheets(“Sheet1”).Range(“B4”).Interior.ColorIndex = xlNone
Worksheets(“Sheet1”).Range(“B4”).Font.Color = RGB(0, 0, 255)
For i = 1 To 500
For j = 1 To 100
SetCursorPos x1 + j, y1
Next j
For j = 99 To 0 Step -1
SetCursorPos x1 + j, y1
Next j
Next i
mouse_event MOUSEEVENTF_LEFTDOWN, 0&, 0&, 0&, 0&
Sleep 100
mouse_event MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0&
Sleep 100
SendKeys “{NUMLOCK}”, True
Sleep 100
SendKeys “{NUMLOCK}”, True
Sleep 100
StartTime = Timer
counter = counter + 1
End If
GetCursorPos lngCurPos
x2 = lngCurPos.x
y2 = lngCurPos.y
Sleep 250
Loop
End Sub
This VBA code is designed to periodically move the mouse cursor and simulate mouse clicks, as well as toggle the Num Lock key on and off. The code is intended for Microsoft Excel and includes a user interface that displays the cursor position, time elapsed, time remaining, the number of times the code has been activated, and the total run time.
Here’s an explanation of the code with comments:
Declare the necessary Windows API functions and constants for mouse and cursor operations:
Private Declare PtrSafe Function SetCursorPos Lib “user32” (ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Sub mouse_event Lib “user32” (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Private Const MOUSEEVENTF_RIGHTUP As Long = &H10
Declare PtrSafe Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
2. Initialize the main subroutine, MouseMove:
Sub MouseMove()
3. Declare and initialize variables, set up the worksheet layout, and set default values:
‘… (variable declarations and worksheet setup) …
4. Set up a loop to continuously monitor the cursor position and time elapsed:
Do
‘… (monitor cursor position, time elapsed, and update the worksheet) …
Loop
5. Do
‘… (monitor cursor position, time elapsed, and update the worksheet) …
Loop
If x1 x2 Or y1 y2 Then
StartTime = Timer
Worksheets(“Sheet1”).Range(“B4”).Interior.ColorIndex = xlNone
End If
6. Update the worksheet with the cursor position, time elapsed, and other information:
‘… (update the worksheet with cursor position, time elapsed, etc.) …
7. When the elapsed time reaches a certain threshold (in this case, SecondsToActivate), move the cursor, simulate mouse clicks, and toggle the Num Lock key:
If SecondsElapsed >= SecondsToActivate Then
‘… (move cursor, simulate mouse clicks, and toggle Num Lock key) …
End If
8. Sleep for a short period before the next iteration of the loop:
Sleep 250
9. Close the MouseMove subroutine:
End Sub
This code will repeatedly move the mouse cursor, simulate left mouse button clicks, and toggle the Num Lock key when the specified time elapses without user interaction.
So I have Data I need to paste daily on one worksheet and update the pivot table and then I want it to automatically update each blank row on the correct person’s name on another worksheet. Is that possible?
2022 Day Saturday Sunday Monday Tuesday Wednesday Thursday
Date 1/1/2022 1/2/2022 1/3/2022 1/4/2022 1/5/2022 1/6/2022
User Name Work Team
Mouse, Micky Cartoon 5
Mouse, Minnie Cartoon 7
Dog, Pluto Cartoon 2
Doggie, Goofy Cartoon 3
Man, Super DC 30
Woman, Wonder DC 35
America, Captain Marvel 30
Widow, Black Marvel 25
Hi and thanks for the previous examples!
Any idea how I could solve this?
“A mouse sits in front of a 5.5m high rock. Every day she will climb 60cm upwards and every night she slips back 10% of her height reached so far. How many days will she have to climb to reach the top of the rock?”
Thanks for the help!
Kath
At the start of day one she has 550cm to climb
at the start of day two she has fallen back 6cm, so will have 496cm.
at the start of day three she has fallen back 11.4cm, so will have 447.40cm
…….
On day 24 she will have 57.86 cm left to climb and will so reach the top.
Simple excel formulas to give this table:
Start Dist. End Height Slip10% Next start
Day1 550.0 60 490.0 60.0 6.0 496.0
Day2 496.0 60 436.0 114.0 11.4 447.4
Day3 447.4 60 387.4 162.6 16.3 403.7
Day4 403.7 60 343.7 206.3 20.6 364.3
Day5 364.3 60 304.3 245.7 24.6 328.9
Day6 328.9 60 268.9 281.1 28.1 297.0
Day7 297.0 60 237.0 313.0 31.3 268.3
Day8 268.3 60 208.3 341.7 34.2 242.5
Day9 242.5 60 182.5 367.5 36.8 219.2
Day10 219.2 60 159.2 390.8 39.1 198.3
Day11 198.3 60 138.3 411.7 41.2 179.5
Day12 179.5 60 119.5 430.5 43.1 162.5
Day13 162.5 60 102.5 447.5 44.7 147.3
Day14 147.3 60 87.3 462.7 46.3 133.5
Day15 133.5 60 73.5 476.5 47.6 121.2
Day16 121.2 60 61.2 488.8 48.9 110.1
Day17 110.1 60 50.1 499.9 50.0 100.1
Day18 100.1 60 40.1 509.9 51.0 91.1
Day19 91.1 60 31.1 518.9 51.9 82.9
Day20 82.9 60 22.9 527.1 52.7 75.7
Day21 75.7 60 15.7 534.3 53.4 69.1
Day22 69.1 60 9.1 540.9 54.1 63.2
Day23 63.2 60 3.2 546.8 54.7 57.9
Day24 57.9 60 -2.1 552.1 55.2 53.1
Dear Sir
Please, what is the error in this program?
Sub XFMRS()
Dim VUELTAS_AT, VUELTAS_BT, RDT, rounddown, roundup
VUELTAS_AT = 25
VUELTAS_BT = 8
RDT = VUELTAS_AT / VUELTAS_BT
If ((RDT) – Int(RDT)) < 0.5 Then
RDT = rounddown(RDT, 0)
Else
RDT = roundup(RDT, 0)
Debug.Print "RDT="; RDT
End If
End Sub
Thanks for help
Best Regards
Hello Team,
I created a drop down according my data, and i required my drop down data should act like selection of item, if i select 1 item 1 time it should save in another sheet, If i selected multiple items, gradually it should form a list of items, for ex, like shopping apps if we select 1 materials it takes another page and note it down, So, I request the team please help me out of this with your valuable code,
Thanks & Regards,
G Shyamsunder Reddy
Great. Thanks for sharing
Hi dear sir/madam
I HV created a sheet with formulas &formattes when I enter data from my userform it replace the formulas in cells.
Kindly provide me a VBA code that add data to sheets but don’t edit or replace my formulas & formates.
Thanks
My email is bellow
spailanee@gmail.com
There is the change in below point
64. Save Selected Range as a PDF
need the macro excel code to designate a specific a printer
Hi Need help on one macro setup to move files from one folder to another
Conditions:
1. I have a excel containing list of names for some files that are kept in “master” folder(column A)
2. The source path in given in Column B for each file name.
3. Similarly the destination path in given in Column C for each file name.
4. From each row of the list, the macro will pull the name, the Source path and the destination path and will move that file.
5. All .xlsx, .pdf and .csv files are in “master” folder some of which are to be transferred to “Mr. A”, “Mr. B” and “Mr. C” folders according to name
6. there are 3 files with same name and with extension .xlsx, .pdf and .csv respectively.
Please help.
Hello Puneet, thanks for those macros, Im looking for one that converts the clipboard contents into 4 lines of the same data copied, however, each line is restricted to 50 characters, any data exceeds or overflow will carry over to the next line below to continue.
So assuming I copy a paragraph from another source and wants to paste it into Excel
Then I want to have it reformat to fit 50 characters per line.
what is the funtion:
tFirstPriority?
is there a way, when i open the excell-file with multiple pages that the cursor is going directly to de cell with de active date?
Thanx.
Private Sub Worksheet_Activate()
Dim FindString As Date
Dim Rng As Range
FindString = CLng(Date)
With Rows(“3:3”)
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
‘Give a message that todays date was not found
MsgBox “Nothing found”
End If
End With
Module1.Macro1
End Sub
I want to convert Numbers to Indian Rupees and convert it into words.
For example:
1.00 = Rupees One and Zero Pise
10.61 = Rupees Ten and Sixty-One Paise
132,61,21,326.31 = Rupees One Hundred Thirty-Two Crore Sixty-One Lakhs Twenty-One Thousand Three Hundred and Twenty-Six and Thirty-One Paise
13,62,74,82,000.21 = Rupees One Thousand Three Hundred Sixty-Two Crores Seventy-Four Lakhs Eighty-Two Thousand and Twenty One Pise
If cell value (D12:D69)=”” in sheet12
Then
1 click hide entire row hide
2 click print preview
After close file die(DE:D69) unhide
Row
Vba code
If possible
This
Is there a way to send the current excel sheet or file as an attachment?
When I click that hyperlink I want the file to be sent as an attachment to that address.
065 Table of Contents – variation. Add images of the first few rows of each sheet beside the hyperlinks. I’ve not error proofed it yet but you can get the idea…
’65. Create a Table of Content
Sub TableofContent()
Dim i As Long
Dim myShape As Object
Dim Rng As Range
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(“Table of Content”).Delete
Application.DisplayAlerts = True
On Error GoTo MyError
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = “Table of Content”
Columns(“A”).ColumnWidth = 40
Columns(“B”).ColumnWidth = 140
Columns(“A:A”).VerticalAlignment = xlTop
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
Sheets(i + 1).Range(“A1:z7”).Copy
Rows(i + 1).RowHeight = 60
‘Cells(“A” & i).VerticalAlignment = xlVAlignCenter
Range(“B” & i + 1).Select
Set Rng = Selection
ActiveSheet.Pictures.Paste.Select
Set myShape = Selection
With myShape
.Top = Rng.Top + 1 ‘points from top
.Left = Rng.Left + 1 ‘points from left
.Width = Rng.Width – 2 ‘points wide
.Height = Rng.Height – 2
.Placement = xlMoveAndSize
End With
Next i
MyError:
Range(“A1”).Select
End Sub
Can you help with VBA codes that will convert a dynamic range to PDF and send to individual WhatsApp number
plz help me
I need VBA code for for data entries form
Id
Name
Adress
Ph NO
Deposit Monthly
Trying to find a way to log maintenance done on equipment. I have made a Table set that highlights when something is past due based on dates need to be done. I am trying to figure out if there is a way to track or make a back log of changes made so you can go back and see, O I did that on this day even outside of the preset dates. Thoughts?
Hi Puneet,
I am hoping to make to leap into VBA/macro world having used Excel on a daily basis for many years!
I followed the steps to create a PERSONAL.XLSB file and then added each of the modules above individually.
Unfortunately, every time I open Excel I now receive a message from the .xlsb file as follows: ‘Microsoft Visual Basic for Applications – Compile error: – Expected: identifier’
I am determined not to let this put me off and not to delete the file until I know more. I also felt it would be a waste of time spent in creating them.
I did a quick Google search a found articles relating to reserved words but I doubt that I have any as I am only using the module above.
Is this something you can help me with?
I have no doubt they will be a quick hit game changer once I get them to run so thanks for your work!
WK
I must say. I know a bit about Excel.
This is most enlightening.
Well done.
Cheers
Hi
Can you please help me in writing a code to translate the below table A format to table B format
Table A
Style/Color Size
852598/104 S
M
882087/404 38
39
40
42
—————————————
Table B
Style/Color Size
852598/104 S M
882087/104 38 39 40 42
Thanks.
Hello, to TextBox1, TextBox2, TextBox3 and TextBox4.up to this point I managed to solve problem. I want to change the values in TextBox1..4 and then transfer them back to the initial addresses (eg A2, B2, C2, D2 cells. I couldn’t solve this.
I am a beginner in VBA programming and I have the following problem that I could not solve:
I have 4 columns with data such as ID, raw material name, price and date. I transferred the data from the raw material name column to a ListBox, I selected a raw material name from the ListBox (column 2) and I transferred the corresponding line values
If you can help me with some tips I would be grateful.
Thank you in advance.
Hi Everyone,
Can someone help me with my macro.
I’m trying to create a macro that can put work week period align with the dates in column A from calendar in Sheet 2 (contains calendar from 2019-2020 with week period in column B). However, I’m not sure if it is possible. For example, March 5, 2020 will fall into Week 10.
Thank you so much.
Hi Puneet
Nice effort to allow users to use your codes.
I have a sheet where in I wish to hide the rows with zero value.
I want to select range of cells as range and wish to give them some formula based on vlookup…
For example I have in one sheet purchase entries done
On the next page I am doing the calculation of gst… So every time I have to change the row reference…As one column I have 2.5% gst.. other column 5%
As of now every time in each column I have to every time change the cell reference or the row reference
I wish to your advise
Hey, the codes mentioned above are amazing, i am so grateful for your help, it helped me learning alot from these codes and increase my efficiency.
Just wanted to know one more thing can we use show details function in Pivot via VBA when we have given a multiple values in rows and we only need to open up some of them amongst all.
Thankyou for this!!.
Regards,
Vinay Verma
it is fine to me, i use it a lot of time and work great, thanks a lot
Superb! This one is golden
hey I want to push messages from combobox (dropdown list) one by one to another text box, shall any body help on this
almost all the subs works….
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..
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.
Thanks Puneet, Excellent Work. You have given me the start I have been looking for.
Don’t forget to check out this guide https://excelchamps.com/vba-tutorials/
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,
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.
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…………….)
The ” simbol you are using is incorrect.
Looks similar but not the same.
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.
Tried two subs – neither worked – at least not in 2016.
Hey Pwyller, which two?
Hi Everyone,
Thanks for gathering all Codes. It takes lot of work.
I want to write code for Adding Rows for below details.
A B C D E F
1 24
2 25
3 28
4 33
Add 2 rows between A2 & A3 and
Add 4 rows between A3 & A4.
Thanks in advance.
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
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
How to import a tif,pdf,img,etc… these types files by clicking button
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! 🙂
Hi Sir,
I have a query with regards to macros in excel, could I contact you via email?
WIth Regards,
Ankitha
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
hi, what is the vba code to highlight the entire row based on cell value?
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
Can you share a code which combines certain numbers (positive & negative) from a given table and calculates to a certain number (say ‘0’)?
Thank you for sharing this make internet better!!, good tips & tricks
Please I want you to help me
Thank you so much!
thanks a lot .
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
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
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…
What is the: save, Delet, Reset, and exit cods in macro
Can you send me please
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.
Try Power Query for that
@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.
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?
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
Great Stuff! Thank you for sharing. Can you please post a code on how to attach a pdf document to outlook
Thank for knowledge sharing.
This is very useful page for VBA learner.
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?
Sub printSelection()
Selection.PrintOutCopies:=1, Collate:=True
End Sub
gives an error message for me: Compile error Syntax error
am I doing something wrong?
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
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
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 (someshar.ars@gmail.com)
Thank you
I would love to have a macro code to replace a sheet name in a formula
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.
Thank you. Great work!!!!
Save to PDF its really usefull.
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
https://excelchamps.com/blog/merge-excel-files-one-workbook/
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
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)
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.
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.
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/
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.
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.
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
Is there any formula to create different file from single work sheet?
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
Thanks for your words, I need to write an entire blog post for it, stay tuned. 🙂
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 : vgsomu@gmail.com
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
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.
I’m writing a blog post about, it will update once it’s done. 🙂
Update: https://excelchamps.com/blog/merge-excel-files-one-workbook/
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
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
How To Split A Workbook To Separate Excel Files In Excel?
these are really helpful for beginners
Thank you so much sir.
Hello,
I would like to know the VBA code to copy an active sheet to multiple sheets in the same work book.
Thank you
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 sree21343@gmail.com. Thanks in advance
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.
Hi I am Looking for a way to convert a Rage Named
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?
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
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
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
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.
hi, I want to create Outlook email macro where emails automatically gets saved in to shared drive. Help needed with coding if anyone knows.
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.
Hi Puneet,
Great job.
Shall i get code for deleting rows if any of the column contains blank cells
Thanks
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.
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=">
How to reverse vlookup in VBA on bottom 20 records from 100 records ?
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.
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..
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
Nice work
Very well articulated, useful tool and helpful. We’ll done, excellent champ
Thanks Puneet, nice work
How to run macro for collecting data from read only file?
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
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/
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.
Excellent would need your support
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.
Great list! Thank you!
Thanks for your words.
thank Puneet Gogia
You are welcome. ?
Thanks Puneet, this is so helpful!
You are welcome. 🙂
Please I want the VBA code to merge multiple excel sheet in one. Can you send me the code please.
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
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)
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”
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
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??
Try this:
‘ DeleteBlankCellsinRow1 Macro
Sub DeleteBlankCellsinRow1()
Rows(“1:1”).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
End Sub
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.
Thanks for the great advice.
Hello Sir,
I want to learn how to create macro. I have the basic knowledge of VB. Please advise from where should I start.
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 bhaiswarpravin@gmail.com
Thanks you Pravin, for the correction. Will correct it soon,
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.
Which version of Microsoft Office you are using?
Office 2007
Hi.. Can someone help me with the vba code to apply filter in pivot table.
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
You can use power query from that.
Thank you for these!!! I am going to start putting many of the to use tomorrow!!
That’s great.
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.
Awesome! Puneet !
Thanks for your words.
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
I’m so glad you liked it.
How to transfer a cell value from main workbook to several workbooks via VBA program, without opening the other several workbooks.
will get back to you.
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?
I assume you want to insert a new row and copy formula as well?
Yes, whatever number of rows are added I need the formula copied to every new row
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
Nevermind, I figured it out
I’m sorry I just missed your update. Please share with me here so that other can make use of it.
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. ?
Please share the error you got.
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
i like to have the code to convert text to uppercase for entire sheet
updated
hi,
would u pls help how to perform vlookup in VBA
reg
Balaji
SUPERB
thank you
Great
Really helpful
Would like to see more VBA codes.
Thanks
updated new codes
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 gshuvishesh@gmail.com
Added.
Thanks Punit for sharing Wonderful Excel tricks….Helped me to automate my few daily routine task in one go….
I’m so glad you liked it.
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.
Thank you, you can share with me.
Thank you in advance for your generosity.
hi Gabriel could you pls share this code to my mail ID also. abhiram.dilip@gmail.com . Thanks in advance
naik.rajan08@gmail.com
hi Gabriel could you pls share this code to my mail ID also. naik.rajan08@gmail.com
Thanks in advance
Really nice,i’d love it.thanks puneet
Thanks Ratanak, For Your Words
nice…highlight active row and column
Thanks Inet
Hi Everyone,
I’m using the below code to send PDFs using outlook.
However, i need it to use a different email address in my outlook instead of the default one
Any suggestions would be greatly appreciated
Thanks in advance
Sub SendEmailWithPDF(bTest As Boolean)
Dim wsM As Worksheet
Dim wsL As Worksheet
Dim wsR As Worksheet
Dim wsS As Worksheet
Dim rngL As Range
Dim rngSN As Range
Dim rngTN As Range
Dim rngPath As Range
Dim c As Range
Dim lSend As Long
Dim lSent As Long
Dim lCount As Long
Dim lTest As Long
Dim lOff As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strSavePath As String
Dim strPathTest As String
Dim strPDFName As String
Dim strSendTo As String
Dim strSubj As String
Dim strBody As String
Dim strMsg As String
Dim strConf As String
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
strMsg = “Could not set variables”
Set wsM = wksMenu
Set wsS = wksSet
Set wsL = wksList
Set wsR = wksRpt
Set rngL = wsL.Range(“StoreNums”)
Set rngSN = wsR.Range(“rngSN”)
Set rngTN = wsS.Range(“rngTN”)
Set rngPath = wsS.Range(“rngPath”)
‘test email address
strSendTo = wsS.Range(“rngSendTo”).Value
lCount = rngL.Cells.Count
‘#columns offset for email address
lOff = 3
If bTest = True Then
strConf = “TEST Emails: ”
lTest = rngTN.Value
If lTest > 0 Then
lCount = lTest
End If
Else
strConf = “STORE Emails: ”
End If
strConf = strConf & lCount _
& ” emails will be sent”
If bTest = True Then
If strSendTo = “” Then
MsgBox “Enter a test email address” _
& vbCrLf _
& “and try again.”
GoSettings
GoTo exitHandler
Else
strConf = strConf & vbCrLf _
& “to ” & strSendTo
End If
End If
strConf = strConf & vbCrLf & vbCrLf
strConf = strConf & “Please confirm: ” _
& vbCrLf & _
“Do you want to send the emails?”
lSend = MsgBox(strConf, _
vbQuestion + vbYesNo, “Send Emails”)
If lSend = vbYes Then
strSubj = wsS.Range(“rngSubj”).Value
strBody = wsS.Range(“rngBody”).Value
strSavePath = rngPath.Value
strMsg = “Could not test Outlook”
On Error Resume Next
Set OutApp = _
GetObject(, “Outlook.Application”)
On Error GoTo errHandler
If OutApp Is Nothing Then
MsgBox “Outlook is not open. ” _
& vbCrLf _
& “Open Outlook and try again”
GoTo exitHandler
End If
strMsg = “Could not set path” _
& ” for PDF save folder”
If Right(strSavePath, 1) “\” Then
strSavePath = strSavePath & “\”
End If
If DoesPathExist(strSavePath) Then
‘continue code below,
‘ using strSavePath
Else
MsgBox “The Save folder, ” _
& strSavePath _
& vbCrLf & “does not exist.” _
& vbCrLf & _
“Files could not be created.” _
& vbCrLf & _
“Please select valid folder.”
wsS.Activate
rngPath.Activate
GoTo exitHandler
End If
strMsg = “Could not start mail process”
For Each c In rngL
rngSN = c.Value
strMsg = “Could not create PDF for ” _
& c.Value
strPDFName = “SalesReport_” _
& c.Value & “.pdf”
If bTest = False Then
strSendTo = c.Offset(0, lOff).Value
End If
wsR.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strSavePath _
& strPDFName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Set OutMail = OutApp.CreateItem(0)
strMsg = “Could not start mail for ” _
& c.Value
On Error Resume Next
With OutMail
.To = strSendTo
.CC = “”
.BCC = “”
.Subject = strSubj
.Body = strBody
.Attachments.Add _
strSavePath & strPDFName
.Send
End With
On Error GoTo 0
lSent = lSent + 1
If lSent >= lCount Then Exit For
Next c
Application.ScreenUpdating = True
wsM.Activate
MsgBox “Emails have been sent”
End If
exitHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set OutMail = Nothing
Set OutApp = Nothing
Set wsM = Nothing
Set wsS = Nothing
Set wsL = Nothing
Set wsR = Nothing
Set rngL = Nothing
Set rngSN = Nothing
Set rngPath = Nothing
Exit Sub
errHandler:
MsgBox strMsg
Resume exitHandler
End Sub
When did you first start referring to VBA codes or macro codes? This seems like an unusual phrase to me. I first heard it about six months ago and I have been programming for decades. Instead, I would refer to VBA subroutines, VBA functions, or VBA macros. Or might refer to code in general; e.g., this code is not clean. But I think that you are using the phrase “VBA codes” to mean “VBA subroutines” and this use seems to be becoming more prevalant.