VBA Code for Google Search Engine

Automatic Openning of Google Search Engine through VBA Code:



Option Explicit
Sub googleSearch()
Dim browser As New InternetExplorer
Dim htmldoc As HTMLDocument
Dim url As String
Dim i, j As Integer
Dim objcollection, objelement As Object

    Application.ScreenUpdating = False
    On Error GoTo Errorhandler
    url = "http://www.google.co.in"
    browser.navigate url
    browser.Visible = True
    MsgBox "Your data is being searched"
    MsgBox "Chck1"
    Set htmldoc = browser.document
    Set objcollection = htmldoc.getElementsByTagName("Input")
        MsgBox "Chck2"
        While i < objcollection.Length
                If objcollection(i).Name = "q" Then
                MsgBox "Chck3"
                    objcollection(i).Value = Range("A2").Value
           
                End If
                MsgBox "Chck4"
            i = i + 1
        Wend
    Set objcollection = Nothing
    Set objcollection = htmldoc.getElementsByTagName("button")
    MsgBox "Chck5"
        While j < objcollection.Length
            If objcollection(j).Type = "submit" Then
                    Set objelement = objcollection(j)
                    objelement.Click
            End If
         MsgBox "Chck6"
           j = j + 1
        Wend
        Set objelement = Nothing
        Set objcollection = Nothing
        Set htmldoc = Nothing
        Set browser = Nothing
        Application.ScreenUpdating = True
    Exit Sub
Errorhandler:
    MsgBox "Error" & Err.Description
End Sub

Creating Worksheet Calendar through VBA

VBA code for creating a Calendar in Excel Worksheet

Option Explicit

Sub createClaendar()

Dim lmonth, ldays As Long

Dim strmonth, straddress As String

Dim myrng, mycell As Range

Dim mydate As Date

    Application.ScreenUpdating = False

    On Error Resume Next

    'removing grid lines in excel sheet

    ActiveWindow.DisplayGridlines = False

    'Fixing cells size

    With Cells

        .ColumnWidth = 6

        .Font.Size = 8

    End With

    'Select quaterly month's name in row wise

    For lmonth = 1 To 4

        Select Case lmonth

            Case 1

                strmonth = "January"

                Set myrng = Range("A1")

            Case 2

                strmonth = "April"

                Set myrng = Range("A8")

            Case 3

                strmonth = "July"

                Set myrng = Range("A15")

            Case 4

                strmonth = "October"

                Set myrng = Range("A22")

        End Select

        'Entering month's name

        With myrng

            .Value = strmonth

            .Font.Bold = True

            .Interior.ColorIndex = 22

                With .Range("A1:G1")

                     .Merge

                     .BorderAround LineStyle:=xlContinuous

                End With

                'seleting months rowwise

            .Range("A1:G1").AutoFill Destination:=.Range("A1:U1")

        End With

        

        

    

      Next lmonth

      lmonth = 1

      For lmonth = 1 To 12

      straddress = Choose(lmonth, "A2:G7", "H2:N7", "O2:U7", "A9:G14", "H9:N14", "O9:U14", "A16:G21", "H16:N21", "O16:U21", _

                "A23:G28", "H23:N28", "O23:U28")

      ldays = 0

            For Each mycell In Range(straddress)

              ldays = ldays + 1

              mydate = DateSerial(Year(Date), lmonth, ldays)

                  If Month(mydate) = lmonth Then

                      'fill each month's range

                          With mycell

                             .Value = DateSerial(Year(Date), lmonth, ldays)

                             .NumberFormat = "ddd dd"

                          End With

                  End If

            Next mycell

      Next lmonth

    

End Sub

Convert Excel Sheet to HTML

Option Explicit
Sub converttoHtml()
Dim myrng As Range
Dim temppathname As String
Dim tempwb As Workbook
Set myrng = ActiveSheet.UsedRange
On Error Resume Next
Application.ScreenUpdating = False
temppathname = Environ("temp") & "/" & Format(Date, "mm-dd-yy") & ".htm"
myrng.Copy
Set tempwb = Workbooks.Add(1)
    With tempwb.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial.xlPasteFormats , , False, False
        ActiveWorkbook.Save
    End With
    With tempwb.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
         Filename:=temppathname, _
         Sheet:=tempwb.Sheets(1).Name, _
         Source:=tempwb.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set tempwb = Nothing
    Set myrng = Nothing
End Sub

Acces VBA Macro from another Excel File

If you want to access VBA Macro from another Excel file Code is as follows:




Option Explicit
Sub accessotherMacro()
Dim pathname As String
Application.ScreenUpdating = False
Dim wb As Workbook
On Error Resume Next
pathname = "C:\Users\abc\Desktop\mybook1.xls"
MsgBox Dir(pathname)
On Error Resume Next
        If Not Dir(pathname) = vbNullString Then
            Set wb = Workbooks.Open(pathname)
            Application.Run (wb.Name & "!test")
        ElseIf Dir(pathname) = vbNullString Then
            MsgBox "File doesnot Exist"
        End If
Application.ScreenUpdating = True




End Sub