VBA Cheat Sheet

Workbook and Worksheets

Total Number of Rows and Columns : Find First Blank Space Position :
No of Rows: 10,48,576 No of Columns : 16,384 x = [Link]([Link]("a3"), " ")
Change the Domain Name of the Sheet :
[Link]([Link]).Properties("_CodeName") = "Summary_Sheet"
Select Multiple Worksheets :
Sheets(Array("Sheet1", "Sheet4", "Sheet5")).Select

Delete Multiple Worksheets : Delete Workbook :

Kill “FilePath\[Link]" ‘ Delete single file
Sheets(Array("Sheet1", "Sheet4", "Sheet5")).Delete
Kill "YourFolderPath\" * .xl * "" ‘ Delete entire excel file from folder
Type of Input Box:

[Link]("Enter number") ‘[ It allow to take cell references ]

[Link]("Enter number") ‘[ Manually Enter ]

Protect and Unprotect Worksheet :

Sheets("Summary").Protect Password:="abc"
Sheets("Summary").Unprotect Password:="abc"
Display and Not Display :

[Link] = False [Link] = False

[Link] = False [Link] = False
[Link] = False [Link] = False
[Link] = True [Link] = False
Code Name of worksheet : Get Name of last worksheet and workbook:
MsgBox Sheets([Link]).Name ‘name of last sheet in the workbook
MsgBox Sheets("Summary").CodeName
MsgBox Workbooks([Link]).Name ‘ name of last opened workbook
Send Email :

[Link] Recipients:=Array("abc@[Link]", "xyz@[Link]"), Subject:="Welcome", ReturnReceipt:=""

Get Full name and Path of Workbook :

MsgBox [Link] [Output—> C:\Users\RAM\desktop\[Link] ]
MsgBox [Link] [Output—> C:\Users\RAM\desktop ]

Save , SaveAs and Close of Workbook :

[Link]
[Link] Filename:=[Link]("UserProfile") & "\desktop\" & "Myworkbook2”
[Link] SaveChanges:=False

Get File Name from SaveAs dialog box :

FileName = [Link]
Dynamic Range Selection
[Link]("a1:a" & Cells([Link], 1).End(xlUp).Row).Select ‘ Range Selection
[Link](1, [Link]).End(xlToLeft).Column ‘Get last column number
[Link]([Link], 1).End(xlUp).Row ‘ Get last row number

Extract Unique Records using advance filter :

Range("a1:a" & Cells([Link], 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[k1], Unique:=True

Text to Column :
Range("A2:a9").TextToColumns Destination:=Range("e2"), DataType:=xlDelimited, Space:=True, _
FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 9))
Loop
Select Case Statements For Loop Do While Loop
Dim chr As String
Example-1: Example-1: Example-2:
chr = InputBox("Enter the char")
For i = 1 To 20 Step 3 Dim i As Integer, sum As Integer Dim i As Integer, total As Integer
Select Case chr
MsgBox i i = 10 i=5
Case "A" To "L"
Next i sum = 0 total = 0
MsgBox "between A and L"
Case "M" To "T" Do While i >= 5 Do
MsgBox "between M and T" Example-2: sum = i + sum total = i + total
Case "U" To "Z" Dim j As Integer i=i-1 i=i-1
MsgBox "between U and Z" For j = 1 To [Link] Loop Loop While i >= 10
Case Else MsgBox Worksheets(j).Name MsgBox total
MsgBox "Wrong choice" Next j MsgBox sum
End Select
Extract Number: Text in Reverse Order
dim j as Integer
Dim i As Integer, MyName As String, ReverseName As String
For j = 1 To Len(Range(”a1”)) MyName = [Link]("A2").Value
If [Link](Range(”a1”), j, 1) Like "[0-9]" Then For i = 0 To [Link](MyName) - 1
Range(”b1”).Value = Range(”b1”).Value & [Link](Range(”b1”), j, 1) ReverseName = ReverseName & [Link](MyName, Len(MyName) - i, 1)
End If Next i
Next j MsgBox ReverseName

Do Until Loop For Each Loop

Example-1: Example-2:
Dim i As Integer Dim i As Integer [a1].Select
i=1 i=1 For Each Sheet In [Link]
Do Do Until i > 10 ActiveCell = [Link]
Cells(I, 1) = 2 * i MsgBox i [Link](1, 0).Select
i=i+1 i=i+1 Next Sheet
Loop Until i = 11 Loop
First name , Middle name and Last name by VBA
full_name = [Link]("a2")
arr = [Link](full_name, " ")
first_name = arr(0) 'Return the first element of array
last_name = arr(UBound(arr)) 'Return last element of array
middle_name = [Link](full_name, [Link](full_name, " "), [Link](full_name) - [Link](first_name & last_name))
[Link]("b2") = first_name
[Link]("c2") = Trim(middle_name)
[Link]("d2") = last_name
Files and Folders
Add Library Get Special Folder Path
Add References > Microsoft Scripting Runtime Dim fso As New FileSystemObject
or WindowsFldr = [Link](0)
[Link] ("C:\Windows\System32\[Link]") SystmFldr = [Link](1)
TempFldr = [Link](2)
Loop on File and Folder File Dialog to select Folder
Dim fso As New FileSystemObject Dim FolderPath As String
Dim myFile As file Dim fso As New FileSystemObject
Dim myFolder As Folder [Link](msoFileDialogFolderPicker).Title = "Select Data Folder"
Set myFolder = [Link]("D:\Users\RAM\Desktop\Airtel\") [Link](msoFileDialogFolderPicker).Show
' Open All Excel Files FolderPath = [Link](msoFileDialogFolderPicker).SelectedItems(1) & "\"
For Each myFile In [Link] MsgBox FolderPath
If [Link](myFile) = "xlsx" Then
[Link] myFile
Else
End If
Next myFile

Check File / Folder Exist or Not Open application using VBA

Dim fso As New FileSystemObject
Call Shell("[Link] " & FolderPath, vbNormalFocus) ‘ open folder
Dim FolderPath As String
Call Shell("notepad")
FolderPath = "C:\Users\Abhishek\Desktop\Santosh1"
If [Link](FolderPath) Then ‘ [Link](FilePath)
MsgBox "Specified Folder is Exist in the system", vbInformation, "Folder status"
[Link] (FolderPath)
Else
MsgBox "Folder Doesn't Exist"
End If

Pivot Table
Dim pTable As PivotTable
Dim pCache As PivotCache
Dim pSheet As Worksheet
Dim pDataRange As Range
Dim pField As PivotField

Set pSheet = [Link](Before:=Sheets(1))

[Link] = "Summary"
Set pDataRange = [Link]("a1").CurrentRegion

Set pCache = [Link](SourceType:=xlDatabase, SourceData:=pDataRange)

Set pTable = [Link](TableDestination:=[Link]("a3"), TableName:="MyPivotTable1")

Set pField = [Link]("name")

[Link] = xlRowField
[Link] = 1

Set pField = [Link]("Amount")

[Link] = xlDataField
[Link] = xlCount
[Link] = "Total Count"

Set pField = [Link]("year")

[Link] = xlPageField
[Link]("2016").Visible = False ‘ unselect 2016 in pivot filter

' Remove Subtotal

On Error Resume Next
For Each pField In [Link]
[Link](1) = False
Next
Outlook Connectivity
Add Library / Create Object
Add References > Microsoft Outlook 15.0 Object Library
or
Set OutlookApp = CreateObject("[Link]")
Set ObjMail = [Link](olMailItem)

Send Mail via Outlook Send Chart on Outlook Mail Body

Dim Outlook_App As New [Link] Dim Outlook_App As Object
Dim Outlook_Mail As [Link] Dim Outlook_Mail As Object
Dim chart_path As String
Set Outlook_App = New [Link]
Set Outlook_Mail = [Link](olMailItem) chart_path = Environ("userprofile") & "\[Link]"
[Link]("MyChart").[Link] Filename:=chart_path, Filtername:="gif"
With Outlook_Mail
.To = "" Set Outlook_App = CreateObject("[Link]")
.CC = "" Set Outlook_Mail = Outlook_App.CreateItem(0)
.BCC = ""
.Subject = "Welcome" With Outlook_Mail
.HTMLBody = "Dear Sir,<br><br> Greetings for the day. " .to = "abc@[Link]"
'.[Link] .Subject = "Chart - Summary"
.Display .HTMLBody = "Hi <br> I am sending below chart.<br> <img src= '" & chart_path & "'>"
.Send .display
End With End With
Set Outlook_App = Nothing
Set Outlook_Mail = Nothing Kill chart_path
Set Outlook_App = Nothing
Set Outlook_Mail = Nothing

Chart
Create Chart
Dim Data_Range As Range
Dim ch As Shape
Set Data_Range = [Link]("a1").CurrentRegion

Set ch = [Link].AddChart2(Style:=12, XlChartType:=xlColumn, Left:=200, Top:=0, Width:=300, Height:=200)

With [Link]
.SetSourceData Data_Range
.[Link] = "Product Summary"
.HasLegend = False
.FullSeriesCollection(1).ApplyDataLabels
.FullSeriesCollection(2).ApplyDataLabels
.FullSeriesCollection(2).Points(1).Select
[Link] = vbYellow
.FullSeriesCollection(2).ChartType = xlLineStacked
.FullSeriesCollection(2).[Link] = vbBlue
.Axes(xlValue).[Link]
End With
Database Connectivity
Add Library / Create Object
Add References > Microsoft ActiveX Data Objects 2.8 Library
or
Set Conn = CreateObject("[Link]")
Set Record_set = CreateObject("[Link]")

Retrieve Data From SQL Server

Dim Conn As New [Link]
Dim rs As New [Link]
Dim sql_cmd As String

'Open SQL Connection

[Link] = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Data Source=rk-pc;Initial Catalog=rmg_master"
[Link]

'SQL Query
sql_cmd = "select * from client_details"

'Open Record Set

Set [Link] = Conn
[Link] sql_cmd, Conn

'Header for data

[a1].Select
For Each i In [Link]
[Link] = [Link]
[Link](0, 1).Select
Next i

'Copy to Excel
[Link]("a2").CopyFromRecordset rs
[Link]
[Link]

Retrieve Data From MS-Access

Dim conn As Object
Dim rs_data As Object
Set conn = CreateObject("[Link]")
Set rs_data = CreateObject("[Link]")

'Open MS-Access Connection

[Link] = "Provider=[Link].12.0;" & _
"Data Source=D:\VBA Interview\[Link];" & _
"user id=; password="
[Link]

'Open Record Set

With rs_data
.ActiveConnection = conn
.Source = "Select * from Table1"
.Open
End With

'Table Header
[Link]("a1").Select
For Each Field In rs_data.Fields
[Link] = [Link]
[Link](0, 1).Select
Next Field

'Copy Data to Excel

[Link]("a2").CopyFromRecordset rs_data