Classification of Macros
  • Record Macro
  • Written Macro

    • Ways to Provide Comment

    APOSTROPHE '

    Rem Statement

    Default File Location

  • Document and Settings\ Pavan\My documents

    • Dot Separator\Intellisense

  • It joins and seperates its objects and Identifiers

    • Data Types

  • (i)Object Variables (ii)Data Variables
  • Integer,String,Date,Decimal,Boolean,Variant

    • Classification of Windows

  • Local Window, Watch Window, Immediate Window

    •  

    Application Object

  • Application.SheetsInNewWorkbook = 3
  • Application.DisplayAlerts = False
  • Application.Wait (Now() + TimeValue("00:00:01"))
  • Range("A" & i).Value = Application.RecentFiles(i).Name
  • Application.ScreenUpdating = False
  • Application.Calculate
  • Application.Calculation = xlCalculationManual
  • Application.Calculation = xlCalculationAutomatic

    • FileDialog

  • MsofiledialogFileepicker
  • MsofiledialogFolderpicker
  • MsoFileDialogOpen
  • MsoFileDialogSaveas

    • Dim FD As FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
    .Title = "Select The Workbook"
    .AllowMultiSelect = False
    .Filters.Add "Excel", "*.xlsx", 1
    If .Show = -1 Then
    MsgBox .SelectedItems(1)
    Workbooks.Open (.SelectedItems(1))
    Else:
    MsgBox "Not Selected The File"
    End If
    End With

    Add Custom List

    Application.AddCustomList listarray:=Array("A", "B", "C", "D", "E")
    Sheet2.Range("D1").Value = "A"
    Sheet2.Range("D1").AutoFill
    Destination:=Range("D1:D5"), Type:=xlFillDefault

  • Application.AddCustomList listarray:=Sheet2.Range("F1:F6")
  • MsgBox Application.CustomListCount
  • Application.DeleteCustomList (1)
  • Application.DeleteCustomList ListNum:=1

    • Range Object

    Dim Rng As Range
    Set Rng = Range("A15")
    Set Rng = Range("A4:C16")
    Set Rng = Cells(2, 1)
    Set Rng = Range(Cells(2, 1), Cells(15, 5))
    Rng.Select
    Rng.Value = "abc"
    Rng.Interior.ColorIndex = 11
    Directions
    Range("J8").Value = 10 Range("J8:J2").FillUp
    Range("J8:J14").FillDown
    Range("J8:C8").FillLeft
    Range("J8:P8").FillRight

    Remove Duplicates

    Rng.AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("D1"), unique:=True

    Auto Filter

  • Range("A1").AutoFilter
  • ActiveSheet.AutoFilterMode = False
  • Range("A1").AutoFilter Field:=1, Criteria1:="A*", Operator:=xlFilterValues
  • Sh.Range("A1").AutoFilter Field:=1, Criteria1:="A*", Operator:=xlOr, Criteria2:="P*", Operator:=xlFilterValues

    • Sort The Data

    Sheets("Sheet2").Sort.SortFields.Clear
    Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, _ Order:=xlAscending
    With ThisWorkbook.Sheets("Sheet2")
    Sort.SetRange Range("A1").CurrentRegion
    .Sort.Header = xlYes
    .Sort.MatchCase = False
    .Sort.Orientation = xlSortColumns
    .Sort.Apply
    End With

    Add the shape Object

    With Sh.Range("L5:Q6")
    Dim Shp As Shape
    Set Shp = Sh.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=.Left, _
    Top:=.Top, _
    Width:=.Width, _
    Height:=.Height)
    End With

    Time and Date Functions

  • Dateserial(Year,Month,Date)
  • Range("A1").Value = Date
  • Range("A1").Value = Year("1 - Oct - 2016")
  • Range("A1").Value = Time
  • Range("A2").Value = Day("15-oct-2016")
  • Range("A1").Value = Month("1-Oct-2016")
  • Range("A1").Value = Hour("23:15")
  • Range("A1").Value = Second("17:18:49")
  • Range("A7").Value = Weekday(Date)
  • Range("A8").Value = MonthName(Month(Date))
  • Range("A9").Value = Day(DateSerial(2016, 4, 0))
  • Cells(i, 1).Value = MonthName(Month:=i, abbreviate:=False) .. March
  • Cells(i, 2).Value = MonthName(Month:=i, abbreviate:=True) -- Mar
  • Cells(i, 1).Value = DateAdd("d", 5, "1-1-2016")
  • MsgBox DateAdd("yyyy", 2, "1-jan-2016")
  • Range("A2").Value = DateAdd("yyyy", -2, "1-oct-2016")
  • Range("A3").Value = DateAdd("ww", -2, "1-oct-2016") .. Deduct two weeks
  • Range("A4").Value = DateAdd("w", -2, "1-oct-2016") .. Deduct two week days
  • Range("A5").Value = DateAdd("d", -2, "1-oct-2016")
  • Range("A6").Value = DateAdd("m", 45, "1-oct-2016")
  • Range("A7").Value = DateAdd("h", 3, "1-oct-2016")
  • Cells(i, 3).Value = Weekday(Range("A" & i))
  • Cells(i, 2).Value = WeekdayName(Weekday(Cells(i, 1)))
  • MsgBox DateDiff("d", "1-jan-2015", "1-March-2015")
  • Range("C2").Value = DateDiff("d", Range("A2"), Range("B2"))
  • Range("d2").Value = DateDiff("ww", Range("A2"), Range("B2"))
  • Range("E2").Value = DateDiff("h", Range("A2"), Range("B2"))
  • Range("F2").Value = DateDiff("s", Range("A2"), Range("B2"))
  • Range("G2").Value = DateDiff("m", Range("A2"), Range("B2"))
  • MsgBox DatePart("w", "1-oct-2016")
  • MsgBox DatePart("d", "1-oct-2016")

    • Instr Function

    returns first occurace number Here output = 3

  • InStr("orange", "a")

    • MID Function

  • mid(string,start,length)

    • For i = 1 To Len(word)
    If Mid(word, i, 1) = "a" Or _
    Mid(word, i, 1) = "u" Or _
    Mid(word, i, 1) = "n" Then
    result = result & Mid(word, i, 1)
    Range("B1").Value = result
    End If
    Next

    Like operator

    For i = 1 To Len(Data)
    If Mid(Data, i, 1) Like "[0-9]" Then
    numb = numb + Mid(Data, i, 1)
    Cells(r, 2).Value = numb
    ElseIf UCase(Mid(Data, i, 1)) Like "[A-Z]" Then
    str = str + Mid(Data, i, 1)
    Cells(r, 3).Value = str
    ElseIf Not Mid(Data, i, 1) Like "[0-9]" Or UCase(Mid(Data, i, 1)) Like "[A-Z]" Then
    spechar = spechar + Mid(Data, i, 1)
    Cells(r, 4).Value = spechar
    End If
    Next

    Isnumeric

    For i = 1 To Len(j)
    If IsNumeric(Mid(j, i, 1)) Then
    numb = numb & Mid(j, i, 1)
    Cells(r, 2) = numb
    ElseIf Not IsNumeric(Mid(j, i, 1)) Then
    stri = s
    tri & Mid(j, i, 1)
    Cells(r, 3) = stri
    End If
    Next

    Range Object

    Group the rows

  • Range("A2:A18").Group
    • Clear outline
  • Range("A18").ClearOutline

    • Worksheet Functions

  • Cells(I, 3).Value = Application.WorksheetFunction.Rank(Cells(I, 2), data)

    • Dictionary

  • Dim dict As New Scripting.Dictionary
  • Dict.Add Key:="Apple", Item:=45
  • If Dict.Exists("Banana") Then
    MsgBox Dict("Banana")
    End If

    • Dim KeyValue As Variant
    For Each KeyValue In Dict.Keys
    MsgBox Dict(KeyValue)
    Next

    Arrays

  • Array is a collection of relevant data
  • (i)Static variable
  • Dim ArrayOne(5) As Variant
  • (ii) Dynamic Variable
  • Dim IntData() As Integer
  • ReDim Preserve AllTheData(i)
    • Copy entire array into range
  • SH.Range("I5").Resize(UBound(ArrayName, 1), 1).Value = ArrayName

    • Pivot table

    Dim pc As PivotCache
    Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, Rng)
    Dim Pv As PivotTable
    Set Pv = pc.CreatePivotTable(Range("H3"), tablename:="information")

    With Pv
    .PivotFields("Item").Orientation = xlRowField
    .PivotFields("location").Orientation = xlColumnField
    .PivotFields("Company").Orientation = xlPageField
    With .PivotFields("Quantity")
    .Orientation = xlDataField
    .Function = xlSum
    End With

  • For i = 1 To .PivotFields.Count
  • Range("h" & r).Value = .PivotFields(i).Name

    • Controls

  • Form Controls, Active X Controls

    • Check Box

  • If CheckBox1.Value = True Then j = 5
  • If CheckBox1.Value = True And CheckBox2.Value = False
  • If CheckBox1.Value = True Then .Font.Bold = True
  • If CheckBox2.Value = True Then .Font.Italic = True
  • If CheckBox3.Value = True Then .Font.Size = 16
  • If CheckBox4.Value = True Then .Interior.ColorIndex = 24

    • Combobox

  • cb.ListFillRange = "Sheet2!A1:A11"
  • ComboBox1.Clear
  • ComboBox1.AddItem "Pen"

    • With cb
    .Name = "myname"
    .Left = Columns("B:E").Left
    .Width = Columns("B:E").Width
    .Height = Rows("10:11").Height
    .Top = Rows("10:11").Top
    End With

  • Shp.ControlFormat.RemoveAllItems
  • Shp.ControlFormat.AddItem Sh.Range("Fruits").Rows(r).Value

    •  

    Create Button

    Dim b As Button

    Set r = Range("G" & n)

    Set b = ActiveSheet.Buttons.Add(r.Left, r.Top, r.Width, r.Height)

    b.Caption = "button" & i

    TextBox
  • Range("A2") = Me.txt.Value
  • Me.txt.Value = ""
  • txt.SetFocus
    • List Box
  • ListBox1.AddItem i
  • ListBox1.Clear

    • For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
    SH.Cells(r, 1).Value = Me.ListBox1.List(i, 0)
    SH.Cells(r, 2).Value = Me.ListBox1.List(i, 1)
    SH.Cells(r, 3).Value = Me.ListBox1.List(i, 2)
    SH.Cells(r, 4).Value = Me.ListBox1.List(i, 3)
    SH.Cells(r, 5).Value = Me.ListBox1.List(i, 4)
    r = r + 1
    End If
    Next

     

    With Me.ListBox1
    .Clear
    .Font.Size = 14
    .Font.Name = "Calibri"
    .ColumnCount = 5
    .ColumnHeads = True
    .RowSource = "Sheet2!A2:F" & LastRow
    .ListStyle = fmListStyleOption
    .MultiSelect = fmMultiSelectMulti
    .TextAlign = fmTextAlignCenter
    End With

     

    File System Object

    To create a Folder in C drive
  • MkDir ("C:\FolderName")
    • To remove the folder in C drive
  • RmDir ("C:\FolderName")
    • to delete all text files available in D\Consolidation
  • Kill ("D:\Consolidation\*.TXT")
  • Filecopy(Source,Destincation path)
  • FileCopy "E:\sales\abc.txt", "F:\sales\abc.txt"
  • Curdir()
  • Range("A1").Value = CurDir
  • Chdir .. change drive
  • filename = Dir("E:\sales")

    • File Exists

    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject

    Dim FilePath As String
    FilePath = "C:\Test\Samples.xlsx"

    If FSO.FileExists(FilePath) = True Then
    Workbooks.Open (FilePath)
    Else:
    MsgBox "Workbook doesn't exists in the below mentioned path" & vbNewLine & FilePath
    End If

    Connection Strings

     

    Sequel Database

    Dim ConnectionString As String
    ConnectionString = "Provider=SQLOLEDB;Data Source=PAVAN-PC;Initial Catalog=Excel_Access_SQL;Integrated Security=SSPI"
    Con.Open ConnectionString

    Access Database

    Con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & FileName & ";" & _
    "User Id=admin;Password="
    Con.Open

    With rs
    .AddNew
    .Fields("Student Name") = UserForm1.TextBox1.Value
    .Fields("Roll No") = UserForm1.TextBox2.Value
    .Fields("Class") = UserForm1.TextBox3.Value
    .Fields("Science") = UserForm1.TextBox4.Value
    .Fields("Social") = UserForm1.TextBox5.Value
    .Fields("Maths") = UserForm1.TextBox6.Value
    .Fields("GK") = UserForm1.TextBox7.Value
    .Update
    End With
    rs.Close

     

Hi Everyone,
Welcome to VBA Macros Tutorial. This Tutorial provides comprehensive knowledge on VBA Macros to the user. Hope it enhances your coding skills. If you like this web page kindly Share this to your near and dear. I Prepared this content as per my level of knowledge, if any changes required kindly bring to my notice. Thanks for visiting this web page

Thanks,
Pavan Kumar Gundlapalli