Synchronous V/S Asynchronous XMLHTTPRequest

Synchronous vs. Asynchronous. In the context of the XmlHttpRequest object, when you use Synchronousrequests, the request is carried out in line with the process that called it, and everything waits on it to complete. Asynchronous requests, however, once submitted, don't wait on a response. A listener is set up to listen for the response, but the execution of the code doesn't stop and wait for it. 

Get URL/Win Explorer from Web Browser

Sub GetOpenWindowsList()

    Dim SWs As New SHDocVw.ShellWindows
    Dim IE As SHDocVw.InternetExplorer
 
    For Each IE In SWs
 
     'MsgBox IE.LocationName
'below mentioned line retrieves URL/Explorer from Internet Explorer
     MsgBox IE.LocationURL
   
   
   
    Next IE
 
 
End Sub

MSXML2.XMLHTTP Application in VBA

It's an utlity to retrieve info from Amazon(US/UK) based on MSXML Services from Microsoft.
Benefits of this model:

1.Comparatively faster
2.Stand Alone Application
3.No Limit on no. of ISBN
4.Doen't get interrupted when a wrong ISBN encountered
5.Start/Stop at your will.

You can view this application on following url:



https://docs.google.com/open?id=0B23eJ2xd9ODyTjJNc1NaLVlQemM

Web Application using MSXML2 for VBA

As I have promised to begin with MSXML blog, I giving you a snippet of VBA code to retrieve data amazon.com for a particular ISBN

Option Explicit
Sub getDatafromAmazon()
Dim baseurl As String
Dim oXML As MSXML2.XMLHTTP
Dim mainurl As String
Dim tag1 As String
Dim tag2 As String
Dim shtml
Dim htmlbody
Dim authorname As String
Dim i As Long
Dim j As Long
On Error GoTo Errorhandler
baseurl = "http://www.amazon.com/s/ref=nb_sb_noss?url=search-alias%3Daps&field-keywords="
tag1 = "<a href=""/Adam-Greenspan/e/B001IQW882/"
tag2 = "</a>"
Set oXML = New MSXML2.XMLHTTP
mainurl = baseurl & Range("A3").Value
Range("B3").Value = mainurl
    oXML.Open "GET", mainurl, True
    oXML.send
    Do
        DoEvents
    Loop Until oXML.readyState = 4
    shtml = oXML.responseText
  
   
    i = InStr(shtml, tag1)
    i = i + 83
   
    j = InStr(i, shtml, tag2)
    authorname = Mid(shtml, i, j - i)
    Range("C3").Value = authorname
    Exit Sub
   
Errorhandler:
    MsgBox "Error" & Err.Description
  
End Sub

What is XMLHttpRequest

We are coming up with some excited blogs on MSXML2.XMLHTTP Application. Before that you need to get some brief idea about XMLHttpRequest to understand code

                            XMLHttpRequest (XHR) is an API available in web browser scripting languages such as JavaScript.

It is used to send HTTP or HTTPS requests directly to a web server and load the server response data directlyback into the script. The data might be received from the server as  XML[4], HTML, or as plain text.Data from the response can be used directly to alter the DOM of the currently active document in the browser window without loading a new web page document. The response data can also be evaluated/manipulated by client-side scripting.

               The following sections demonstrate how a request using the XMLHttpRequest object functions within a conforming user agent based on the W3C Working Draft.The HTTP and HTTPS requests of the XMLHttpRequest object must be initialized through the open method.This method must be invoked prior to the actual sending of a request to validate and resolve the request method, URL, and URI user information to be used for the request.This method does not assure that the URL exists or the user information is correct.This method can accept up to five parameters, but requires only two, to initialize a request.

                              open( Method, URL, Asynchronous, UserName, Password ) 

               The first parameter of the method is a text string indicating the HTTP request method to use.The request methods that must be supported by a conforming user agent, defined by the W3C draft for the XMLHttpRequest object, are currently listed as the following.

                                                            GET (Supported by Internet Explorer 7 (and later), Mozilla 1+)

                                                            POST (Supported by Internet Explorer 7 (and later), Mozilla 1 (and later))

                                                HEAD (Supported by Internet Explorer 7 (and later))

                                                PUT

                                                DELETE

                                                OPTIONS (Supported by Internet Explorer 7 (and later))

               However, request methods are not limited to the ones listed above. The W3C draft states that a browser may support additional request methods at their own discretion. The second parameter of the method is another text string, this one indicating the URL of the HTTP request. The W3C recommends that browsers should raise an error and not allow the request of a URL with either a different port or ihost URI component from the current document.The third parameter, a boolean value indicating whether or not the request will be asynchronous, is not a required parameter by the W3C draft.

The default value of this parameter should be assumed to be true by a W3C conforming user agent if it is not provided. An asynchronous request ("true") will not wait on a server response before continuing on with the execution of the current script. It will instead invoke the onreadystatechange event listener of the XMLHttpRequest object throughout the various stages of the request. A synchronous request ("false") however will block execution of the current script until the request has been completed, thus not invoking the onreadystatechange event listener.

               The fourth and fifth parameters are the username and password, respectively. These parameters, or just the username, may be provided for authentication and authorization if required by the server for this request.

The send method

To send an HTTP request, the send method of the XMLHttpRequest must be invoked. This method accepts a single parameter containing the content to be sent with the request.

                                                      Send( Data )

             This parameter may be omitted if no content needs to be sent.

After a successful and completed call to the send method of the XMLHttpRequest,responseText will contain the response of the server in plain text by a conforming user agent, regardless of whether or not it was understood as XML.

Integrate Google Chrome With VBA

Instead of opening url with Internet Explorer u can use Google Chrome to navigate l using VBA.







Sub test()

  Dim chromePath As String

  chromePath = "C:\Users\Username\AppData\Local\Google\Chrome\Application\chrome.exe"

  Shell (chromePath & " -url http:matrix.in")

End Sub

0& in VBA Parlance

0 is a number.
Unfortunately, there are several number data types - Integer, Long, Single, Double, Currency, etc.

With no data type identifier after the 0, it is implied to be of the native Integer (the default). Therefore this 0 is expressed as an Integer, which makes it a 16-bit 0.

However, many API functions use Longs and you should not pass an Integer 0 into a Long (that's like putting M&Ms in a cookie jar!)
You should pass a Long 0, which will be a 32-bit 0, as the function requests a 32-bit long long number.
So, therefore you add a &:

An & after a number or a variable means that it is a Long (which is 32-bits).
0& is a 32-bit 0.
x& is a 32-bit variable (this is obsolete because it is better to Dim x As Long rather than Dim x& - the x As Long is clearly a long, and the x& is not obvious)

&H is hexadecimal notation - used when functions are trying to show or set specific bit values - this is used when it would not be efficient to express a value in base 10 notation.

For example: 0011 0000 1000 1101 (16-bit integer) these are often used to set bit flags.
You can use a simple lookup table to convert this to hexadecimal
&H308D (if you're like me, you've memorized it - it's only 16 numbers)

It takes much more time to convert this to decimal.
:)

And you should be able to answer the last question on your own now. :)

P.S. ByVal 0& is passed to an API parameter declared as Any to specify that you don't want to put anything there.

How to Build an Array Formula in Excel 

An array formula is a special formula that operates on a range of values in Excel . When you build an array formula in a worksheet, you press Ctrl+Shift+Enter to insert an array formula in the array range.

To get an idea of how you build and use array formulas in a worksheet, consider the example below. This worksheet is designed to compute the biweekly wages for each employee. It will do this by multiplying each employee's hourly rate by the number of hours worked in each pay period. Use an array formula instead of creating the following formula in cell R10 and copying it down to cells R11 through R13:

Building an array formula to calculate hourly wages for the first pay period.

=A4*R4

You can create the following array formula in the array range:

={A4:A7*R4:R7}

This array formula multiplies each of the hourly rates in the 4 x 1 array in the range A4:A7 with each of the hours worked in the 4 x 1 array in the range R4:R7. This same formula is entered into all cells of the array range (R10:R13) as soon as you complete the formula in the active cell R10. To see how this is done, follow along with the steps required to build this array formula:

1.      Make cell R10 the active cell, and then select the array range R10:R13 and type = (equal sign) to start the array formula.

You always start an array formula by selecting the cell or cell range where the results are to appear. Note that array formulas, like standard formulas, begin with the equal sign.

2.      Select the range A4:A7 that contains the hourly rate for each employee, type * (an asterisk for multiplication), and then select the range R4:R7 that contains the total number of hours worked during the first pay period.

3.      Press Ctrl+Shift+Enter to insert an array formula in the array range.

Excel inserts braces around the formula and copies the array formula {=A4:A7*R4:R7} into each of the cells in the array range R10:R13.

When entering an array formula, you must remember to press Ctrl+Shift+Enter instead of just the Enter key because this key combination tells Excel that you're building an array formula, so that the program encloses the formula in braces and copies it to every cell in the array range.

The figure below shows you the February wage table after completing all the array formulas in three ranges: R10:R13, AI10:AI13, and AJ10:AJ13. In the second cell range, AI10:AI13, the following array formula was entered to calculate the hourly wages for the second pay period in February:

Hourly wage spreadsheet after entering all three array formulas.

{=A4:A7*AI4:AI7}

The following array formula was entered in the third cell range, AJ10:AJ13, to calculate the total wages paid to each employee in February 2010:

{=R10:R13+AI10:AI13}

When you enter an array formula, the formula should produce an array with the same dimensions as the array range that you selected. If the resulting array returned by the formula is smaller than the array range, Excel expands the resulting array to fill the range. If the resulting array is larger than the array range, Excel doesn't display all the results. When expanding the results in an array range, Excel considers the dimensions of all the arrays used in the arguments of the operation. Each argument must have the same number of rows as the array with the most rows and the same number of columns as the array with the most columns.

Sharing a Workbook in Excel for Simultaneous Edit or Modification:

Multiple users can share and modify excel  workbook.  Updated data will be available all the time. You can track changes across network using user’s login name and the date they made update. Workbook however needs to be kept in a shared network. 

           Open your workbook.

               Navigate to Review on the toolbar

               Click on the Share Workbook icon

               Place a check on the check box that says Allow more than one user at the same time.

               Click on OK

               Now, save your workbook on a network share

VBA – Control Arrays

What is a Control Array?

A Control Array is a group of controls that share the same name type and the same event procedures. They are a convenient way to handle groups of controls (Same Type) that perform a similar function. All of the events available to the single control are available to the array of controls.

Can we create Control Arrays in VBA?

Even though, VBA doesn’t allow us to to create Control Array like in vb6 and vb.net, we can still create Control Array in VBA using Class Module.

Why do we need Control Arrays in VBA?

Control Arrays mainly have these advantages

1.     Controls in a Control Array share the same set of event procedures. This results in you writing less amount of code.

2.     Control Arrays uses fewer resources.

3.     You can effectively create new controls at design time, if you need to.

Let’s say you have 10 textboxes in your UserForm (see image below)

And you want all 10 to be numeric textboxes. Numeric textboxes are those text boxes where you can only type numbers.

Now imagine writing this code 10 times for each and every textbox?

This is where we will use Control Array of Textboxes and assign them the same procedure.

To start with add a new Class and name it Class1. Now paste this code in the Code area of Class1 module

Public WithEvents TextBoxEvents As MSForms.TextBox

Private Sub TextBoxEvents_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Select Case KeyAscii

    '<~~ 48 to 57 is AscII code for numbers. 127 is for 'Delete' and 8 is for 'Backspace'

    Case 48 To 57, 127, 8

    Case Else

        KeyAscii = 0

    End Select

End Sub

and in the UserForm Initialize event, paste this code.

Option Explicit

Dim TextArray() As New Class1

Private Sub UserForm_Initialize()

    Dim i As Integer, TBCtl As Control

    For Each TBCtl In Me.Controls

        If TypeOf TBCtl Is MSForms.TextBox Then

            i = i + 1

            ReDim Preserve TextArray(1 To i)

            Set TextArray(i).TextBoxEvents = TBCtl

        End If

    Next TBCtl

    Set TBCtl = Nothing

End Sub

 For Reference:

http://siddharthrout.wordpress.com/2011/08/05/vba-control-arrays/

Run an .exe file through VBA

Sub test_shell()

Dim program As String, taskid As Integer

program = "C:\Windows\notepad.exe"
taskid = Shell(program, vbNormalFocus)


End Sub

Create Unlocked cells on a protected Sheet

A situation arises when we need to give access to specific cells of a shared excel file depending on UserId.
VBA code for this mentioned below:




Sub specificAccesstocellsinWorksheet()
    If Environ("COMPUTERNAME") = "SOUM-BJS" Then
     
        ActiveSheet.Unprotect
        ThisWorkbook.Sheets(1).Range("B1:B21").Locked = False
        ActiveSheet.Protect

    End If


End Sub

User Defined Types(UDT) for VBA

User Defined Types (UDTs) are a convenient way to store related data in one variable. The most useful way one can use UDT to pass information between procedures. Here is a simple example  of how to use UDT. The type statement is used to define UDT and must be outside of any procedures.

Option Explicit

Private Type Applicant

    firstname As String

    lastname As String

    resumerecvd As Boolean

    interviewdate As Date

End Type

Sub defineUDT()

    Dim myapp As Applicant

    myapp.firstname = "Soumyendu"

    myapp.lastname = "Choudhury"

    myapp.resumerecvd = True

    myapp.interviewdate = #7/15/2011#

    useUDT myapp

    

End Sub

Sub useUDT(myInput As Applicant)

    

        MsgBox myInput.firstname

        MsgBox myInput.lastname

        MsgBox myInput.resumerecvd

    

End Sub

Use of DoEvents in VBA

   DoEvents( )

	Pauses execution to let the system process other events.

REMARKS

	·	The DoEvents function always returns zero.
	·	DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
	·	DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component.. In the latter case, the task can continue completely independent of your application, and the operating system takes case of multitasking and time slicing.
	·	Any time you temporarily yield the processor within an event procedure, make sure the procedure is not executed again from a different part of your code before the first call returns; this could cause unpredictable results. In addition, do not use DoEvents if other applications could possibly interact with your procedure in unforeseen ways during the time you have yielded control.

 For Example:

Do While browser.Busy Or browser.readyState <> READYSTATE_COMPLETE

   DoEvents

UserForm1.Caption = "Record Number:- " & i

   

Loop

Window APIs for VBA

In this blog, I'll give you brief idea about Window APIs and their application in VBA.

API stands for Application Programming Interface.
There are several reasons to use Window APIs instead of built-in VBA functions:

Speed - although there might be only a fraction of a millisecond's difference between a VBA function and using an API call, if you are using it repeatedly, then this difference mounts up. A good example of this is recursively searching for a file through the directories and sub-directories.

Extensibility - you wish to perform something that cannot be achieved using VBA functions.


In general, an API is declared as below:

[Private|Public] Declare [Function|Sub] APIName Lib [DLLName] (Alias APIName) (Arguments) (Return Type)

For example:

Private Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long

[Private|Public]:
This determines the scope of the function of subprocedure. This is mostly a matter of preference. I prefer to declare my API calls private within a module, and then use a function to call them. This allows me to have a module that is stand-alone and can be copied to another database without reliance on other modules.

[Function|Sub]:

Whether it is a subprocedure or a function. Nearly all APIs are functions, and they nearly all return a value directly.

[DLLName]:
The name of the DLL that the procedure is in. For the standard DLLs, user32.dll, kernel32.dll or gdi32.dll you can omit the file extension, but for all other DLLs you must include the file extension.


(Alias APIName):
If you have declared the API as being different from the name that it is known within the DLL you must specify the correct name here. There are several reasons why you may wish to do this:

• The name of the API is not a valid VBA function name, such as '_lwrite';
• You are declaring it twice, for example to accept different argument types to get around the 'As Any' variable type;
• You wish to have a common naming policy for API calls, such as prefixing them all with 'api'

Note that the API name must be in the correct case - 'findfile' is not equal to 'FINDFILE'



(Arguments):
As with VBA procedures, APIs may accept various arguments. However, this is one area where care needs to be taken to ensure that you pass ByRef or ByValue as needed. You will often also need to predeclare string arguments to be a certain length. You may also find that you pass a Type Structure as an argument, and the values that you want are in that Type Structure.
(Return Value):
The datatype that the API returns. Normally this will be a Long Integer, with 0 often indicating an error.

To find more about API please go through:

http://www.applecore99.com/api/api001.asp



The following table lists the common operating environment library files.


Dynamic Link Library Description
Advapi32.dll Advanced API services library supporting
numerous APIs  including many security and Registry calls
Comdlg32.dll Common dialog API library
Gdi32.dll Graphics Device Interface API library
Kernel32.dll Core Windows 32-bit base API support
Lz32.dll 32-bit compression routines
Mpr.dll Multiple Provider Router library
Netapi32.dll 32-bit Network API library
Shell32.dll 32-bit Shell API library
User32.dll Library for user interface routines
Version.dll Version library
Winmm.dll Windows multimedia library
Winspool.drv     Print spooler interface that contains the print

VBA Code for Closing a Workbook after Specified Timeperiod

Sub workbook_open()
Dim start, finish, totaltime, totaltimeinminutes, timeinminutes
Application.DisplayAlerts = True
timeinminutes = 3
    If timeinminutes > 1 Then
    'calculating total remaining time
    totaltimeinminutes = (timeinminutes * 60) - (1 * 60)
    start = Timer
    'do other activity for 2 min.s
    Do While Timer < start + totaltimeinminutes
       DoEvents
    Loop
    finish = Timer
    totaltime = finish - start
    Application.DisplayAlerts = False
    MsgBox "This file has been open for " & totaltime / 60 & "minutes,You have 1 minute to save before Excel closes"
    End If
    start = Timer
    Do While Timer < start + (1 * 60)
        DoEvents
    Loop
    finish = Timer
    totaltime = finish - start
    Application.DisplayAlerts = False
    MsgBox "Excel will now close"
    Application.Quit
End Sub

Using Worksheet function for VBA code

The  macro sums the salaries for employees in a specific department and a specific location

Sub calcSalaries()
Dim objDept As Range, objLoc As Range, objSal As Range
Dim strDept, strLoc As String, cursum As Currency
Sheets("Employees").Activate
With ActiveCell.CurrentRegion
    Set objDept = .Columns(4)
    Set objLoc = .Columns(5)
    Set objSal = .Columns(6)
    strDept = InputBox(Prompt:="Which department(cancel or blank for all departments)?", Default:="Finance")
    If strDept = vbNullString Then strDept = "*"
    strLoc = InputBox(Prompt:="Which department(cancel or blank for all departments)?", Default:="New Delhi")
    If strLoc = vbNullString Then strLoc = "*"
    cursum = WorksheetFunction.SumIfs(objSal, objDept, strDept, objLoc, strLoc)
    MsgBox cursum
    MsgBox "The total for" & strDept & " in" & strLoc & " is:" & FormatCurrency(cursum)
End With


End Sub

Convert a number to a date using VBA

This VBA procedure converts a number, in yyyymmdd format, to a regular date like mm/dd/yyyy.  For example, a number like 20090427 will get converted to 4/27/2009.





Public Function formatdatefromnumber(dateNumber)
On Error GoTo err_formatdatefromnumber

    Dim fmtYear, fmtMonth, fmtDay As String
        If IsNull(dateNumber) Then
            formatdatefromnumber = vbNullString
            Exit Function
            
        End If
        
        If Len(CStr(dateNumber)) <> 8 Then
            formatdatefromnumber = vbNullString
            Exit Function
        End If
        If Not IsNumeric(dateNumber) Then
            formatdatefromnumber = vbNullString
            Exit Function
        End If
        fmtYear = Mid(dateNumber, 1, 4)
        fmtMonth = Mid(dateNumber, 5, 2)
        
        If CInt(fmtMonth) > 12 Then
        formatdatefromnumber = vbNullString
        Exit Function
        End If
        fmtDay = Mid(dateNumber, 7, 2)
        If CInt(fmtDay) > 31 Then
        formatdatefromnumber = vbNullString
        Exit Function
        End If
        formatdatefromnumber = Format(DateSerial(fmtYear, fmtMonth, fmtDay), "mm/dd/yyyy")
        Exit Function

err_formatdatefromnumber:
MsgBox Err.Number & " " & Err.Description, vbCritical, "DateFromNumber()"
err_formatdatefromnumber = vbNullString
Exit Function
        
End Function

Disable Keyboard in VBA Code

Sub KeyboardOff()

   Application.DataEntryMode = True
End Sub

Disable Right Click When A Sheet Is Active

VBA Code for disable right click when a sheet is active:


Application.CommandBars("Cell").Enabled = False

Using Switch Function in VBA

Sub Exercise()
    Dim Status As Integer, EmploymentStatus As String
    Status = 1
    EmploymentStatus = "Unknown"
    'In the first argument, pass a Boolean expression
    'that can be evaluated to True or False. If that condition
    'is true, the second argument would be executed.
    EmploymentStatus = Switch(Status = 1, "Part Time")
    MsgBox ("Employment Status: " & EmploymentStatus)
End Sub

Convert No.to Text (Upto 10 crore) using VBA

Function spellnumber(ByVal num)

Dim decimalplace, count As Integer
ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Lakh"
    Place(4) = " Crore"
    Place(5) = " Trillion "
    decimalplace = InStr(num, ".")
 
 
num = Trim(Str(num))
    If decimalplace > 0 Then
    'extracting value after decimal
            
        Cents = getTens(Left(Mid(num, (decimalplace + 1), 2) & "00", 2))
     
    'extracting  remaining value before decimal
        num = Trim(Left(num, decimalplace - 1))
     
     
    End If
    count = 1
 
    Do Until Len(num) = 0
     
    If count = 1 Then
 
         
            Temp = getHundreds(Right(num, 3), count)
         
            num = Left(num, Len(num) - 3)
         
         
    ElseIf count > 1 Then
         
         
             
            'remaining no. is of two digits
            If Len(num) = 2 Then
         
                num = Right(num, Len(num))
                Temp = getHundreds(num, count)
                num = vbNullString
            'remaining no. is of one digit
            ElseIf Len(num) = 1 Then
                num = Right(num, Len(num))
                Temp = getHundreds(num, count)
                num = vbNullString
            'remaining no. is of more than one digit
            ElseIf Len(num) > 2 Then
                             
                Temp = getHundreds(Right(num, 2), count)
                num = Left(num, Len(num) - 2)
             
            End If
         
       
    End If
 
        If Temp <> "" Then Dollars = Temp & Place(count) & Dollars
     
     
     count = count + 1
           
     
     
    Loop
 
        Select Case Dollars
            Case ""
                Dollars = "No Rupees"
            Case "One"
                Dollars = "One Rupees"
            Case Else
                Dollars = Dollars & " Rupees"
        End Select

        Select Case Cents
            Case ""
                Cents = " and No Paisa"
            Case "One"
                Cents = " and One Paisa"
            Case Else
            Cents = " and " & Cents & "Paisa"
        End Select
 
 
spellnumber = Dollars & Cents
End Function




Function getTens(tenstext)

Dim result As String
result = vbNullString

    If Val(Left(tenstext, 1)) = 1 Then
        Select Case Val(tenstext)
            Case 10: result = "Ten"
            Case 11: result = "Eleven"
            Case 12: result = "Twelve"
            Case 13: result = "Thirteen"
            Case 14: result = "Fourteen"
            Case 15: result = "Fifteen"
            Case 16: result = "Sisxteen"
            Case 17: result = "Seventeen"
            Case 18: result = "Eighteen"
            Case 19: result = "Ninteen"
            Case Else
        End Select
    Else
        Select Case Val(Left(tenstext, 1))
            Case 2: result = "Twenty"
            Case 3: result = "Thirty"
            Case 4: result = "Fourty"
            Case 5: result = "Fifty"
            Case 6: result = "Sixty"
            Case 7: result = "Seventy"
            Case 8: result = "Eighty"
            Case 9: result = "Ninety"
            Case Else
        End Select
        result = result & getDigit(Right(tenstext, 1))
        'result = result
    End If
    getTens = result
End Function

Function getDigit(digit)
    Select Case Val(digit)
        Case 1: getDigit = "One"
        Case 2: getDigit = "Two"
        Case 3: getDigit = "Three"
        Case 4: getDigit = "Four"
        Case 5: getDigit = "Five"
        Case 6: getDigit = "Six"
        Case 7: getDigit = "Seven"
        Case 8: getDigit = "Eight"
        Case 9: getDigit = "Nine"
        Case Else: getDigit = ""
    End Select
End Function

Function getHundreds(ByVal number, ByVal count)
 
    Dim result As String
 
 
    If Val(number) = 0 Then Exit Function
    'Extracting last three no. of digit
    number = Right(number, Len(number))
 
    If Len(number) = 3 Then
 
        If Mid(number, 1, 1) <> "0" Then
               result = getDigit(Mid(number, 1, 1)) & "Hundred"
 
        End If
        If Mid(number, 2, 2) <> "0" Then
 
            result = result & getTens(Mid(number, 2, 2))
        End If
     
    ElseIf (Len(number) = 2 And (count = 2)) Then
            result = getTens(number) & result
       
    ElseIf (Len(number) = 1 And (count = 2)) Then
            result = getDigit(number) & result
         
    ElseIf (Len(number) = 2) And (count = 3) Then
            result = getTens(number) & result
         
    ElseIf (Len(number) = 1) And (count = 3) Then
            result = getDigit(number) & result
    ElseIf (Len(number) = 1) And (count = 4) Then
            result = getDigit(number) & result
    ElseIf (Len(number) = 2) And (count = 4) Then
            result = getTens(number) & result
         

    End If
    getHundreds = result & getDigit(Right(tenstext, 1))
End Function

Extract particular text from Hyperlink

For example we have a website http://www.amazon.com/Best-Sellers-Books-Architectural-Art-Design/zgbs/books/5005940011/ref=zg_bs_nav_b_2_1 linked to a cell hyperlink in an excel data. From where we need to extract only  5005940011. VBA code for this objective is as follows:


Dim myurl As String
Dim tempval, tempvalnew, nodeid As String

Sub searchVal()

myurl = ActiveCell.Hyperlinks(1).Address


For x = 1 To Len(myurl)
tempval = Mid(myurl, x, 1)

    If InStr(tempval, "/") <> 0 Then
    counter = counter + 1
 
    End If
    If (counter = 6 And tempval <> "/") Then
     
        nodeid = nodeid & tempval
     
    ElseIf counter = 7 Then
    ActiveCell.Offset(0, 1).Value = nodeid
    nodeid = vbNullString
    myurl = vbNullString
        Exit Sub

    End If
 
Next x



End Sub

Timer in Excel using VBA

Public Sub TestTimer()
MsgBox "The timer will switch off in 10 seconds!"
MsgBox ("Currenttime: " & Now)
alertTime = Now + TimeValue("00:00:10")
Application.OnTime alertTime, "TestTimer"
myMacro
End Sub

Determine a Cell in Specified Range or Not

Double click any sheet in VBA Project Explorer and paste following code:

Private Sub Worksheet_SelectionChange(ByVal target As Range)
If Not Intersect(target, Range("myrange")) Is Nothing Then
MsgBox target.Address & "is in myrange"
Else
MsgBox target.Address & "is not in myrange"
End If
End Sub

Move data from Row to Column

When there is a huge data in a single column; we may need to migrate some data to next column using page break. VBA code for this utility:

Option Explicit
Dim sht As Worksheet, myrng As Range, myrng1 As Range, count As Integer, i As Long
Dim myrng2 As Range, rowcount As Long
Sub moveRowtoColumn()
On Error Resume Next
Set sht = ThisWorkbook.Sheets(1)
Set myrng = sht.UsedRange.Columns(1)
count = sht.HPageBreaks.count
i = 0

For i = 1 To count
 
    Set myrng1 = sht.HPageBreaks(i).Location
    Set myrng2 = sht.HPageBreaks(i + 1).Location.Offset(-1, 0)
        If myrng2 Is Nothing Then
            Range(myrng1, myrng.Cells(65500, 1).End(xlUp)).Copy Destination:=sht.Cells(1, i + 1)
        Else
            Range(myrng1, myrng2).Copy Destination:=sht.Cells(1, i + 1)
        End If
     
    Set myrng1 = Nothing
    Set myrng2 = Nothing
Next

sht.Range(sht.HPageBreaks(1).Location.Address, myrng.Cells(65500, 1).End(xlUp).Address).Delete
    Set myrng = Nothing
End Sub

Excel VBA LogTracker

VBA code for generating Excel Log tracker

In module:

Sub eLoggerInfo(Evnt As String)
Application.ScreenUpdating = False
Dim counter As Long
    cSheet = ActiveSheet.Name
        If sheetExists("LoggerInfo") = False Then
            Sheets.Add.Name = "LoggerInfo"
            Sheets("LoggerInfo").Select
            'ActiveSheet.Protect "Pswd", userinterfaceonly:=True
        End If
        Sheets("LoggerInfo").Visible = True
        Sheets("LoggerInfo").Select
        'ActiveSheet.Protect "Pswd", userinterfaceonly:=True
' assigning value to counter
        counter = Range("A1")
       
        If counter <= 2 Then
            counter = 3
            Range("A2").Value = "Event"
            Range("B2").Value = "User Name"
            Range("C2").Value = "Domain"
            Range("D2").Value = "Computer"
            Range("E2").Value = "Date and Time"
        End If
        'fixing event length to 25
        If Len(Evnt) < 25 Then Evnt = Application.Rept(" ", 25 - Len(Evnt)) & Evnt
   
            Range("A" & counter).Value = Evnt
            Range("B" & counter).Value = Environ("UserName")
            Range("C" & counter).Value = Environ("USERDOMAIN")
            Range("D" & counter).Value = Environ("COMPUTERNAME")
            Range("E" & counter).Value = Now()
            counter = counter + 1
          'Deleting  records if no. of records are more than 20000
            If counter > 20002 Then
                Range("A3:A5002").Select
                dRows = Selection.Rows.Count
                Selection.EntireRow.Delete
                counter = counter - dRows
            End If
            Range("A1") = counter
            Columns.AutoFit
            Sheets(cSheet).Select
            Sheets("LoggerInfo").Visible = xlVeryHidden
            Application.ScreenUpdating = True
       
End Sub

Function sheetExists(sheetName As String) As Boolean
On Error GoTo SheetDoesnotExit
    If Len(Sheets(sheetName).Name) > 0 Then
        sheetExists = True
        Exit Function
    End If
SheetDoesnotExit:
        sheetExists = False
End Function
Sub ViewLoggerInfo()
    Sheets("LoggerInfo").Visible = True
    Sheets("LoggerInfo").Select
End Sub
Sub HideLoggerInfo()
    Sheets("LoggerInfo").Visible = xlVeryHidden
End Sub

In Thisworkbook module:

Private Sub workbook_beforeprint(cancel As Boolean)
Dim Evnt As String
Evnt = "Print"
Call eLoggerInfo(Evnt)
End Sub


Private Sub workbook_beforesave(ByVal saveasUI As Boolean, cancel As Boolean)
    Dim Evnt As String
    Evnt = "Save"
    Call eLoggerInfo(Evnt)

End Sub

Private Sub workbook_Open()
    Dim Evnt As String
    Evnt = "Open"
    Call eLoggerInfo(Evnt)

End Sub

Floating Button in VBA

VBA code for creating floating button in excel sheet:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If (Target.Column < 2 And Target.Row < 2) Then Exit Sub
With ActiveSheet.Shapes("CommandButton1")
    .Top = Target.Offset(, 0).Top
    .Left = Target.Offset(, 0).Left
End With
End Sub

Build-up your Logic in VBA(Create Pyramid)

Sub test()
k = 1
c = 9
For i = 10 To 1 Step -1
For j = c To k Step -1

    Cells(i, j) = "*"
     
Next j
k = k + 1
c = c - 1
Next i

End Sub

Calculation of Net Working Days

Here is a small VBA code for calculating net working days excluding Sunday:




Option Explicit


'Date should of "dd-mmm" format in cells

Function clcnetworkingdays(startdate As Date, enddate As Date) As Variant
Dim daystaken As Integer
Dim cnt As Integer, tempCounter As Integer
daystaken = enddate - startdate

    For cnt = 1 To daystaken
        If WorksheetFunction.Text((startdate + cnt), "ddd") = "Sun" Then
            tempCounter = tempCounter + 1
         
         End If
 
    Next
    daystaken = daystaken - tempCounter
    clcnetworkingdays = daystaken
End Function

Add Hyperlink in Excel

We have to create a table of content in Excel worksheet where there will be a sheet hyper link for every data in TOC sheet except Header
VBA Code:





Sub toc()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wkscount As Integer
Dim lp As Integer
Dim wkbname As String
Dim path As String
Set wkb = ActiveWorkbook
wkscount = wkb.Sheets.Count
Set wks = wkb.Sheets.Add(before:=wkb.Sheets(1))
wks.Name = "TOC"
ActiveSheet.Range("a1").Value = "Table of Content"
For lp = 2 To wkscount + 1
wkbname = wkb.Sheets(lp).Name
ActiveSheet.Range("a" & lp).Value = wkbname
path = "file:///" & wkb.path
MsgBox (ActiveCell.Offset((lp - 1), 0).Address)
'Range("A" & lp).Select
'MsgBox (path)
ActiveCell.Offset((lp - 1), 0).Hyperlinks.Add Anchor:=ActiveCell.Offset((lp - 1), 0), Address:="", SubAddress:= _
        ActiveCell.Offset((lp - 1), 0).Value & "!A1", TextToDisplay:=wkbname


'MsgBox wkscount

Next lp

End Sub

Sample code for BeforeRightClick Event

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)

Dim cBar As CommandBar
Dim cmdCon1 As CommandBarControl
Dim cmdCon2 As CommandBarControl

'Prevent the standard popup showing
 Cancel = True

'We must delete the old one first
On Error Resume Next
Application.CommandBars("Ozgrid").Delete

    'Add a CommandBar and set the CommandBar _
     variable to a new popup
     Set cBar = Application.CommandBars.Add _
     (Name:="Ozgrid", Position:=msoBarPopup)

    'Add a control and set our 1st CommandBarControl _
     variable to a new control
     Set cmdCon1 = cBar.Controls.Add
    'Add some text and assign the Control
    With cmdCon1
        .Caption = "I'm a custom control"
        .OnAction = "MyMacro" 'calling macro from Module
    End With

    'Add a control and set our 2nd CommandBarControl _
     variable to a new control
     Set cmdCon2 = cBar.Controls.Add
    'Add some text and assign the Control
    With cmdCon2
        .Caption = "Somu's Macro"
        .OnAction = "AnotherMacro"
    End With

cBar.ShowPopup
End Sub

Dynamic Display of Image in Excel

Insert images in  second sheet of Excel with specified range

Create a name range ‘getChart()’ with formula

=IF(Sheet1!$A$1="pic1",Sheet2!$A$1:$C$9,IF(Sheet1!$A$1="pic2",Sheet2!$A$10:$C$18, IF(Sheet1!$A$1="pic3",Sheet2!$A$19:$C$27,"")))

Draw a drop down list in sheet1 mentioning all three  pics  name

Below draw a range with Camera from a quick access tool bar.

Insert an image in that range and click on that image and insert  =getchart formula bar