Friday, March 2, 2012

To open Excel or CSV from another Excel macro

Here is the code:

Filt = "Excel Files (*.xlsx),*.xlsx,Excel Files (*.xls),*.xls"
FilterIndex = 5
Title = "File 1"
Filename = Application.GetOpenFilename(FileFilter:=Filt, _
FilterIndex:=FilterIndex, Title:=Title)
 Workbooks.Open (FileName)



 To get the file name


P = WorksheetFunction.Substitute(FileName, Left(FileName, InStrRev(FileName, "\")), "")

Validate URL using Excel Macro

Here is the that you can use whether the set of URLs are valid or not valid:

Sub Validate_URLs()
Dim r As Range
Dim URLs As String
For Each r In ActiveSheet.Range("A2:A5146")
URLs = Trim(r.Value)
If Len(URLs) > 0 Then
r.Offset(0, 1).Value = IIf(HttpExists(URLs), "Valid", "Not Valid")
End If
Next r
End Sub
Function HttpExists(sURL As String) As Boolean
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "HEAD", sURL, False
oXHTTP.send
HttpExists = (oXHTTP.Status = 200)
End Function

Friday, February 17, 2012

To automate google search and provide top 10 links

If you would like automate the Google search and would like to know what are all the top 10 websites for the particular search, Here is the macro that automate all your Google searches:

Macro Code:

'' Change this if you want rankings for a region-specific google website, like www.google.co.uk
'' Or, change it to a specific data center IP, like the Caffeine test server: 209.85.225.103
Const GOOGLE_WEBSERVER = "www.google.com"

'' Amount of default-sized result pages to scan
Const PagesToScan = 1

'' Builds the URL of a SERP for a term, starting at a certain result
Function BuildSERPURL(ByVal term As String, ByVal start As Long) As String
BuildSERPURL = "http://" & GOOGLE_WEBSERVER & "/search?start=" & start & "&q=" & term
End Function

'' Fetches a page from the internet
Function FetchPage(ByVal url As String) As String
Dim req As WinHttp.WinHttpRequest
Set req = New WinHttp.WinHttpRequest
req.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
req.Open "GET", url
req.Send
FetchPage = req.ResponseText
End Function

'' Separates and retrieves the hostname from a URL
Function GetHostname(ByVal url As String)
GetHostname = url
End Function

'' Finds an empty row for a new competitor site. Returns the row index
Function FindNextRow()
For Each cell In ActiveSheet.Columns(2).Cells
If Len(cell.Text) < 1 Then
FindNextRow = cell.row
Exit Function
End If
Next
FindNextRow = -1
End Function

'' Processes a single search term
Sub ProcessTerm(ByVal term As String, ByVal myurl As String)
Dim sheet As Worksheet
Dim url As String, contents As String
Dim row As Long, start As Long, page As Long
Dim foundMyUrl As Boolean

Set sheet = Application.ActiveSheet
start = 0
foundMyUrl = False
For page = 1 To PagesToScan
url = BuildSERPURL(term, start)
contents = FetchPage(url)

Dim pos As Long, posEnd As Long
pos = 1
pos2 = 1
Const sig = "

Const Sig2 = "')"">"

'' Find first link
pos = InStr(pos, contents, sig)
pos2 = InStr(pos, contents, Sig2)


While (pos > 0)

pos = pos + Len(sig)
pos2 = pos2 + Len(Sig2)


'' Find end of link
posEnd = InStr(pos, contents, """")
posEnd2 = InStr(pos2, contents, "

")
If posEnd < 1 Then
MsgBox "Failed to parse Google results page"
Exit Sub
End If

'' Extract the URL from the link
url = Mid(contents, pos, posEnd - pos)
a = Mid(contents, pos2, posEnd2 - pos2)

start = start + 1

'If InStr(url, myurl) > 0 Then
'' This my URL. Everything from here on is below me
'foundMyUrl = True
'Else
hostname = GetHostname(url)
row = -1

'' Locate this competitor URL in the existing list
On Error Resume Next
'row = Application.WorksheetFunction.Match(hostname, sheet.Columns(3), 0)
On Error GoTo 0

If row < 2 Then
'' This competitor does not already exist, so add a new row for it
row = FindNextRow
sheet.Cells(row, 2).Value = hostname
sheet.Cells(row, 3).Value = a
'sheet.Cells(row, 5).Value = 0
'' Row exists
End If

'' Count this appearance either below or above me
'If foundMyUrl Then
' sheet.Cells(row, 5).Value = sheet.Cells(row, 5).Value + 1
' Else
'sheet.Cells(row, 4).Value = sheet.Cells(row, 4).Value + 1
'End If
' End If

'' Find next link
pos = InStr(pos, contents, sig)
pos2 = InStr(pos2, contents, Sig2)
Wend
sheet.Cells(row, 2).ClearContents
sheet.Cells(row, 3).ClearContents
Next

Columns("C:C").Select
Selection.Replace What:="
", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("A1").Select

End Sub

'' Main routine
Sub CompetitorResearch()
Dim sheet As Worksheet
Set sheet = Application.ActiveSheet

'' Retrieve my url
Dim myurl As String
myurl = sheet.Cells(2, 1).Text

'' Work through the list of search terms and process each one
row = 2
While (sheet.Cells(row, 1).Text <> "")
Dim term As String
term = sheet.Cells(row, 1).Text
ProcessTerm term, myurl
row = row + 1
Wend

'' Order the result list by "Above me" and then by "Below me", so stronger competitors appear first

'sheet.Range("C:E").Sort sheet.Columns(4), xlDescending, _
sheet.Columns(5), , xlDescending, _
, , xlYes

End Sub


Excel macro to scrape the image from image url

If you would like to download the images from more than 1000 URLs, here is the excel macro to download all the images at one go.

The macro will automatically download all the jpg files from the given urls.

Macro Code:

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long


Public Function DownloadURLtoFile(sSourceURL As String, _
sLocalFileName As String) As Boolean


DownloadURLtoFile = URLDownloadToFile(0&, _
sSourceURL, sLocalFileName, &H10, 0&) = 0&

End Function

Sub DownLoadPics()
Dim cell As Range, rngListOfURL As Range

PTH = Cells(2, 4)

Set rngListOfURL = Sheet1.Range("A2:A1354")

For Each cell In rngListOfURL
If DownloadURLtoFile(cell.Value, PTH & cell.Offset(, 1).Value & ".jpg") Then
cell.Offset(, 2).Value = "Successfully downloaded"
Else
cell.Offset(, 2).Value = "Error - no download"
End If
Next cell

End Sub

Thursday, February 9, 2012

VB References - Microsoft Internet Controls not found

It should be located in your system in the following folder.

Use the "Browse" option from the "References" and add the following dll files

C:\WINDOWS\system32\shdocvw.dll

If it isn't in this directory, search files and folders for shdocvw.dll Once you have it located you can then load into your references.

Friday, January 27, 2012

To open the embedded file from PPT Presentation Mode (Slideshow)


If you would like to open the embedded file from PowerPoint Presentation Mode, you have to make the following settings:



Single Click (Left click) on the embedded file in the slide.

Select Insert -> Action from Toolbar


Under “Mouse Click”, select “Object action” and select “Open” from the option and click OK.


Now you can open your embedded file, even if the PPT is in presentation Mode.

Tuesday, January 24, 2012

To Copy Charts from Excel to PPT using Macro

Using macro you can automate the process of copy the ranges and charts from excel to PPT.

The sample code is :

Sub Chart2PPT()
Dim objPPT As Object
Dim objPrs As Object
Dim objSld As Object
Dim shtTemp As Object
Dim chtTemp As ChartObject
Dim objShape As Shape
Dim objGShape As Shape
Dim intSlide As Integer
Dim blnCopy As Boolean

Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.Presentations.Add
objPPT.ActiveWindow.ViewType = 1 'ppViewSlide

For Each shtTemp In ThisWorkbook.Sheets
blnCopy = False
If shtTemp.Type = xlWorksheet Then
For Each objShape In shtTemp.Shapes 'chtTemp In shtTemp.ChartObjects
blnCopy = False
If objShape.Type = msoGroup Then
' if ANY item in group is a chart
For Each objGShape In objShape.GroupItems
If objGShape.Type = msoChart Then
blnCopy = True
Exit For
End If
Next
End If
If objShape.Type = msoChart Then blnCopy = True

If blnCopy Then
intSlide = intSlide + 1
objShape.CopyPicture
' new slide for each chart
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Next
If Not blnCopy Then
' copy used range
intSlide = intSlide + 1
shtTemp.UsedRange.CopyPicture
' new slide for each chart
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Else
intSlide = intSlide + 1
shtTemp.CopyPicture
' new slide for each chart
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Next

Set objPrs = Nothing
Set objPPT = Nothing
End Sub

For any Custom Macro or Excel solution

If you need any cutom macro require for your work and soultion that you are facing with excel data or fromatting, you can contact me on Fiverr.

I just became a Level 2 seller on #Fiverr.com (@FiverrHQ). Check out my cool gigs:

http://5rr.it/s/qxtj

VLOOKUP Formulae

VLOOKUP(lookup_value,table_array,col_index_num,range_lookup)

Lookup_value The value to search in the first column of the table array (array: Used to build single formulas that produce multiple results or that operate on a group of arguments that are arranged in rows and columns. An array range shares a common formula; an array constant is a group of constants used as an argument.). Lookup_value can be a value or a reference. If lookup_value is smaller than the smallest value in the first column of table_array, VLOOKUP returns the #N/A error value.

Table_array Two or more columns of data. Use a reference to a range or a range name. The values in the first column of table_array are the values searched by lookup_value. These values can be text, numbers, or logical values. Uppercase and lowercase text are equivalent.

Col_index_num The column number in table_array from which the matching value must be returned. A col_index_num of 1 returns the value in the first column in table_array; a col_index_num of 2 returns the value in the second column in table_array, and so on. If col_index_num is:

Less than 1 VLOOKUP returns the #VALUE! error value.
Greater than the number of columns in table_array, VLOOKUP returns the #REF! error value.
Range_lookup A logical value that specifies whether you want VLOOKUP to find an exact match or an approximate match:

If TRUE or omitted, an exact or approximate match is returned. If an exact match is not found, the next largest value that is less than lookup_value is returned.
The values in the first column of table_array must be placed in ascending sort order; otherwise, VLOOKUP may not give the correct value. You can put the values in ascending order by choosing the Sort command from the Data menu and selecting Ascending. For more information, see Default sort orders.

If FALSE, VLOOKUP will only find an exact match. In this case, the values in the first column of table_array do not need to be sorted. If there are two or more values in the first column of table_array that match the lookup_value, the first value found is used. If an exact match is not found, the error value #N/A is returned.

Monday, January 23, 2012

Record a simple Macro

The simple way to start learning macro is "Record Macro" To record a macro in excel 2007 follow this path:

View -> Macros -> Record Macro



Then a new window opens with required specification like Macro name, Shortcut key, store macro in, Description

Note:

The Macro name should not conatin any blanks spaces or any special characters

For shortcut key, avoid usual shortcut keys like Ctrl+v, Ctrl+v etc.,







Once you clicked OK the macro start to record all your activities that you are doing in that excel. To stop the record, again go to views_> Macro-> Stop recording

Introduction to Macro

When you find yourself repeatedly performing the same actions or tasks in your spreadsheets, it might be time for you to create a macro. A macro is a recording of each command and action you perform to complete a task. Then, whenever you need to carry out that task in your spreadsheets, you just run the macro instead.

Macros can be activate by a couple of keystrokes or by a worksheet button so they are easy to execute, and, provided they were recorded correctly, they will always carry out the same steps in the same order with no chance for operator error.

Although complex macros can be created in Excel using the Macro editor, it also possible to create relatively simple ones using the Excel macro recorder. If you are new to using macros in your spreadsheets, this is the right place for you to learn macros