Extracting Data from Website to Excel

Sometimes we need to extract some stock price related info from website to Excel worksheet. Here is the VBA Code to extract info from Yahoo Finance:


Sub getInfoOnine()
Dim qt As QueryTable
Set qt = ActiveSheet.QueryTables.Add(Connection:="Url;http://finance.yahoo.com/q?s=infy", Destination:=Range("B2"))
With qt
        .Name = "Getting online data"
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingAll
        .WebTables = "1,2,3"
        .EnableRefresh = True
        .RefreshPeriod = 10
        .Refresh
End With
End Sub

Example Messagebox Function in VBA

It's a sample code for messagebox function in vba for excel spreadsheet

Sub diplaymessageBox()
Dim stranswer As VbMsgBoxResult
stranswer = MsgBox("Would you like to colour the cell?", vbQuestion + vbYesNo, "Select Option")
If stranswer = vbYes Then
        Selection.Interior.ColorIndex = 8
    End If
End Sub

Importing Txt file into Excel

VBA Code for importing a text file into excel spredaheet

Sub importFile()

Dim filepathName As String

filepathName = InputBox("Enter complete filepath name:")

    With ActiveSheet.QueryTables.Add(Connection:="text;" & filepathName, Destination:=Range("A1"))
        .Name = "Excel Importing Text File"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
   
    End With

End Sub

Automated Search Option for Spreadsheet

Following VBA code is  an extension of existing Find function in  Excel Spreadsheet. Though normal Find

function you have to find desired data in each sheet seperately. Through below mentioned code you can get

the result of searched value across all cells of spreadsheets in an Excel Workbook. Wherever the code will

find the data, it will automatically bold , enlarge that cell and save the worksheet.


Sub searchthroughSheet()
Dim mydata As Variant
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Dim c As range
mydata = InputBox("Enter your value to search:")
On Error Resume Next
For Each ws In wb.Worksheets
With Worksheets(ws.Index).Cells
Sheets(ws.Index).Select
    Set c = .find(mydata, LookIn:=xlValues)
    If Not c Is Nothing Then
            firstaddress = c.Address
            Do
                MsgBox "Match found in" & Worksheets(ws.Index).Name & c.Address
                range(c.Address).Select
                Selection.Font.Bold = True
                Selection.Font.Size = 20
                ActiveWorkbook.Save
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
End With
Next ws
End Sub

Copy Specific Cells in a Worksheet by VBA

'VBA  Code to copy specified cells from all the files in a folder

Option Explicit
Dim objFso As Object, pathname As String, eachfile, objFolder As Object, wb As Workbook
Sub getDatafromAnotherfile()
Set objFso = New Scripting.FileSystemObject
Set wb = ThisWorkbook
pathname = "C:\Users\AJS-Client\Desktop\Check\GMU-Dubai21.12.2013"
Set objFolder = objFso.GetFolder(pathname)
For Each eachfile In objFolder.Files
MsgBox objFso.GetExtensionName(eachfile)
   If objFso.GetExtensionName(eachfile) = "xls" Then
 
        Call Openfile(eachfile)
   End If
 
Next
Set wb = Nothing
End Sub

Public Sub Openfile(eachfile)


Workbooks.Open eachfile

ActiveWorkbook.Sheets(1).Range("A2:C2").Copy wb.Sheets(1).Range("A2")
ActiveWorkbook.Close


End Sub