In this tutorial, we will show you how you can quickly and easily use the Visual Basic For Application (VBA) programming language to extend the capabilities of Excel and Microsoft Office to your specific needs and tangibly improve your efficiency when working with the software. You do not need to have programming experience to benefit from the information in this article, but you are expected to have a basic knowledge of Excel. If you’re a beginner, we recommend you first read the article, “11 Excel Formulas to Start Using Now” to familiarize yourself with the basic features of Excel.
We have prepared several ready-made macros with great functionality that you can use off the shelf to optimize your work. To use them you just need to install them in your Excel file. The next paragraph informs the reader how to install a macro in Excel. Skip this part if you already know how to do this.
How to install a macro?
In Excel, press the keyboard shortcut alt + F11. This will take you to the Excel VBA editor. Then, on the left side, right click on the Microsoft Excel Objects folder and select Insert => Module. This is where the macros are placed. To make the excel file macro-enabled you need to save it as such. From the file => save as tab, choose save as macro-enabled workbook (with the .xlsm extension) It’s time to write your first macro!
Translated with DeepL.com (free version)
1. Copy data from one file to another
This macro is very useful as it shows how you can copy a range of data into vba and how to create and name new excel files (workbooks). You can build on it according to your needs:
Sub CopyFiletoAnotherWorkbook()
'Copy the data
Sheets("Example 1").Range("B4:C15").Copy
'Create a new workbook
Workbooks.Add
'Paste the data
ActiveSheet.Paste
'Turn off application alerts
Application.DisplayAlerts = False
'Save the newly file. Change the name of the directory.
ActiveWorkbook.SaveAs Filename:="C:\Temp\MyNewBook.xlsx"
'Turn application alerts back on
Application.DisplayAlerts = True
End Sub
2. Show hidden rows
Sometimes Excel files contain hidden lines for better viewability. Here is a macro that will show all rows in the active sheet:
Sub ShowHiddenRows() Columns.EntireColumn.Hidden = False Rows.EntireRow.Hidden = False End Sub
3. Delete empty rows and columns
Blank rows in Excel are a problem in data processing. Here’s how to get rid of them!
Sub DeleteEmptyRowsAndColumns() 'Declare your variables. Dim MyRange As Range Dim iCounter As Long 'Define the target Range. Set MyRange = ActiveSheet.UsedRange 'Start reverse looping through the range of Rows. For iCounter = MyRange.Rows.Count To 1 Step -1 'If entire row is empty then delete it. If Application.CountA(Rows(iCounter).EntireRow) = 0 Then Rows(iCounter).Delete 'Remove comment to See which are the empty rows 'MsgBox "row " & iCounter & " is empty" End If 'Increment the counter down Next iCounter 'Step 6: Start reverse looping through the range of Columns. For iCounter = MyRange.Columns.Count To 1 Step -1 'Step 7: If entire column is empty then delete it. If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then Columns(iCounter).Delete End If 'Step 8: Increment the counter down Next iCounter End Sub
4. Finding an empty cell
Sub FindEmptyCell() ActiveCell.Offset(1, 0).Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop End Sub
5. Sorting numbers
The following macro sorts numbers from a column in ascending order on double click. Place it in Sheet 1, not in a module, for it to work::
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Declare your Variables
Dim LastRow As Long
'Find last row
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Sort ascending on double-clicked column
Rows("6:" & LastRow).Sort _
Key1:=Cells(6, ActiveCell.Column), _
Order1:=xlAscending
End Sub
6. Remove blank spaces
Sometimes excel data contains extra blanks (spans) that can interfere with data analysis and the use of formulas. Here is a macro that removes all the blanks between the data that are pre-selected with the mouse:
Sub TrimTheSpaces()
'Declare your variables
Dim MyRange As Range
Dim MyCell As Range
'Save the Workbook before changing cells
Select Case MsgBox("Can't Undo this action. " & _
"Save Workbook First?", vbYesNoCancel)
Case Is = vbYes
ThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
'Define the target Range.
Set MyRange = Selection
'Start looping through the range.
For Each MyCell In MyRange
'Trim the Spaces.
If Not IsEmpty(MyCell) Then
MyCell = Trim(MyCell)
End If
'Get the next cell in the range
Next MyCell
End Sub
7. Replace empty cells of several columns with a value.
As mentioned before, empty cells interfere with data processing and pivot table creation. Here is code to replace the empty values with 0. This macro has a very big application because you can similarly remove N/A results, as well as locate and replace other characters such as periods, commas, colons, etc.
Sub FindAndReplace()
'Declare your variables
Dim MyRange As Range
Dim MyCell As Range
'Save the Workbook before changing cells?
Select Case MsgBox("Can't Undo this action. " & _
"Save Workbook First?", vbYesNoCancel)
Case Is = vbYes
ThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
'Define the target Range.
Set MyRange = Selection
'Start looping through the range.
For Each MyCell In MyRange
'Check for zero length then add 0.
If Len(MyCell.Value) = 0 Then
MyCell = 0
End If
'Get the next cell in the range
Next MyCell
End Sub
8. Coloring repeated values from several columns
Sometimes there are duplicate values in multiple columns that we want to highlight. Here’s a macro that does just that:
Sub HighlightDuplicates() 'Declare your variables Dim MyRange As Range Dim MyCell As Range 'Define the target Range. Set MyRange = Selection 'Start looping through the range. For Each MyCell In MyRange 'Ensure the cell has Text formatting. If WorksheetFunction.CountIf(MyRange, MyCell.Value) > 1 Then MyCell.Interior.ColorIndex = 36 End If 'Get the next cell in the range Next MyCell End Sub
9. Create pivot table
The macro can be used to generate pivot tables. Especially useful if you frequently make the same type of pivot tables. With a little upgrade one could automate the whole pivot table creation process.
Sub PivotTableForExcel2007()
Dim SourceRange As Range
Set SourceRange = Sheets("Sheet1").Range("A3:N86")
ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SourceRange, _
Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="", _
TableName:="", _
DefaultVersion:=xlPivotTableVersion12
End Sub
10. Automatically send an email with an Excel attachment
My favorite macro. Allows you to attach and send the file you are working with to a predefined email address, message title and template text!
Sub SendFIleAsAttachment() 'Declare your variables 'Set reference to Microsoft Outlook Object library Dim OLApp As Outlook.Application Dim OLMail As Object 'Open Outlook start a new mail item Set OLApp = New Outlook.Application Set OLMail = OLApp.CreateItem(0) OLApp.Session.Logon 'Build your mail item and send With OLMail .To = "[email protected]; [email protected]" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" .Attachments.Add ActiveWorkbook.FullName .Display 'Change to .Send to send without reviewing End With 'Memory cleanup Set OLMail = Nothing Set OLApp = Nothing End Sub
11. Send all Excel charts from one file to a PowerPoint presentation
Sub SendExcelFiguresToPowerPoint()
'Set reference to Microsoft Powerpoint Object Library
'Declare your variables
Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim i As Integer
'Check for charts; exit if no charts exist
Sheets("Slide Data").Select
If ActiveSheet.ChartObjects.Count < 1 Then
MsgBox "No charts existing the active sheet"
Exit Sub
End If
'Open PowerPoint and create new presentation
Set PP = New PowerPoint.Application
Set PPPres = PP.Presentations.Add
PP.Visible = True
'Start the loop based on chart count
For i = 1 To ActiveSheet.ChartObjects.Count
'Copy the chart as a picture
ActiveSheet.ChartObjects(i).Chart.CopyPicture _
Size:=xlScreen, Format:=xlPicture
Application.Wait (Now + TimeValue("0:00:1"))
'Count slides and add new slide as next available slide number
ppSlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPSlide.Select
'Paste the picture and adjust its position; Go to next chart
PPSlide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
Next i
'Memory Cleanup
Set PPSlide = Nothing
Set PPPres = Nothing
Set PP = Nothing
End Sub
12. Sending an Excel table to word
Sub ExcelTableInWord()
'Set reference to Microsoft Word Object library
'Declare your variables
Dim MyRange As Excel.Range
Dim wd As Word.Application
Dim wdDoc As Word.Document
Dim WdRange As Word.Range
'Copy the defined range
Sheets("Revenue Table").Range("B4:F10").Cop
'Open the target Word document
Set wd = New Word.Application
Set wdDoc = wd.Documents.Open _
(ThisWorkbook.Path & "\" & "PasteTable.docx")
wd.Visible = True
'Set focus on the target bookmark
Set WdRange = wdDoc.Bookmarks("DataTableHere").Rangе
'Delete the old table and paste new
On Error Resume Next
WdRange.Tables(1).Delete
WdRange.Paste 'paste in the table
'Adjust column widths
WdRange.Tables(1).Columns.SetWidth _
(MyRange.Width / MyRange.Columns.Count), wdAdjustSameWidth
'Reinsert the bookmark
wdDoc.Bookmarks.Add "DataTableHere", WdRange
'Memory cleanup
Set wd = Nothing
Set wdDoc = Nothing
Set WdRange = Nothing
End Sub
13. Output a single word of text in one cell
We can use formulas if we want to subtract a certain number of characters. But what if we only want to subtract the second word or number from a text with words and symbols in one cell? We can create our own function using VBA to do this. Let’s create two functions: findword and findwordrev. Here’s the code in vba:
Function FindWord(Source As String, Position As Integer) As String On Error Resume Next FindWord = Split(WorksheetFunction.Trim(Source), " ")(Position - 1) On Error GoTo 0 End Function Function FindWordRev(Source As String, Position As Integer) As String Dim Arr() As String Arr = VBA.Split(WorksheetFunction.Trim(Source), " ") On Error Resume Next FindWordRev = Arr(UBound(Arr) - Position + 1) On Error GoTo 0 End Function
Току що създадохме две нови функции в Ексел. Функцията =FindWordRev(A1,1) изкарва последната дума от клетка A1. Функцията =FindWord(A1,3) изкарва третата дума от клетка A1 И т.н.
14. Prohibition to modify the text in the Excel file
Sometimes we want to protect the data in the file so that only we can modify it. Here’s how it can be done with VBA:
Sub ProtectSheets() 'Declare your variables Dim ws As Worksheet 'Start looping through all worksheets For Each ws In ActiveWorkbook.Worksheets 'Protect and loop to next worksheet ws.Protect Password:="1234" Next ws End Sub
