After a long time I came up with an interesting trick, it might be rarely useful for anyone but it is tricky. And the trick is “How to delete all worksheets except one” without any loops by VBA.

I always love to use array everywhere (I mean where possibleJ), so here is the trick

Worksheets() collection can accept Index array , and we need an expression that will return that index array. We all knows that  “=Row(1:5)” will return {1;2;3;4;5} , so we just need to create a dynamic index array to supply in worksheets() collection.

How to do that?

I use Evaluate very often. Evaluate() can evaluate any string that is an identical expression. So here is my Expression

“=Row(1:” & Worksheets.count-1 &”)”

If we evaluate this expression by Evaluate(“=Row(1:” & Worksheets.count-1 &”)”) it will return a 2D array, but in this case worksheets() accepts  1D array, we to make it 1D we would need to transpose this array, so the next expression is “Application.Transpose(Evaluate(“=Row(1:” & Worksheets.count-1 &”)”))

And finally, put this array in Worksheets().

Worksheets(Application.Transpose(Evaluate(“=Row(1:” & Worksheets.count-1 &”)”))).Delete

So this is a single line code to delete all worksheets except one. It will ask for confirmation to delete the worksheets , you can use Application.DisplayAlert=False  before and make it true after this line.

Thats all.

Thanks For reading.

Rajan verma


Sometime there are more than one account are configured in outlook and when we use VBA to send Emails, it use the default account. but in case you have to send emails through other account , you can use this code.
the bold lines are telling outlook to use another account to send emails.
Sub SendEmail()
    Dim objOutlook As Object
    Dim objItem As Object
    Dim rngRange As Range
    Dim rngRow As Range
    Dim objOutlookAccount As Object
    Dim lngCounter As Long
    Set rngRange = Intersect(Sheet1.Range(“A1″).CurrentRegion.Offset(1), Sheet1.Range(“A1″).CurrentRegion)
    Set objOutlook = CreateObject(“Outlook.Application”)
    lngCounter = 0
    If Not rngRange Is Nothing Then
        For Each rngRow In rngRange.Rows
            Set objOutlookAccount = GetOutlookAccount(objOutlook, rngRow.Cells(1).Value)
            If Not objOutlookAccount Is Nothing Then
                Set objItem = objOutlook.CreateItem(0)
                With objItem
                    Set .SendUsingAccount = objOutlookAccount
                     .to = rngRow.Cells(2).Value
                    .Subject = rngRow.Cells(3).Value
                    .body = rngRow.Cells(4).Value
                    .send
                    lngCounter = lngCounter + 1
                End With
            End If
        Next rngRow
    End If
    If lngCounter > 0 Then
        MsgBox lngCounter & ” Mail sent”, vbInformation
    Else
        MsgBox “No mail sent,please check if you have these account configure”, vbCritical
    End If
End Sub
Function GetOutlookAccount(objOutlook As Object, strEmailId As String) As Object
   Dim objOAccount As Object
    For Each objOAccount In objOutlook.Session.Accounts
        If objOAccount.DisplayName = strEmailId Then
            Set GetOutlookAccount = objOAccount
            Exit For
        End If
    Next objOAccount
End Function
to use this code , please have your data in this format. this code will send all email on one click.
SendEmailUsingThisAccount Email address(es) Subject Body Text
Account1@gmail.com Email@gmail.com Subject1 BodyText1
Account2@gmail.com Email@gmail.com Subject1 BodyText1
Account1@gmail.com Email@gmail.com Subject1 BodyText1
Thanks for reading.

Many times i have seen this query on Excel discussion groups and forums to convert values for a specific formulas on worksheets. so i have decided to post a something about that. it might be little helpful for Excel users.

here is a code which will convert formulas to values on every sheets, this code asks formula name which need to be converted in value and then start looking the formulas  and where any cells contain that specific formulas (not only that single formula but it can be with in another formula) it will evaluate that formula and will put the value in the cells.

Sub ConvertFormulaToValues()
    Dim rngRange As Range
    Dim VarArr
    Dim strFormula As String
    Dim varEle
    Dim lngR As Long
    Dim lngC As Long
    Dim lngCount As Long
    Dim wksSheet As Worksheet
    Dim wksLastActive As Worksheet
    strFormula = InputBox(“Enter formula name to replace with values”)
    lngCount = 0
    Application.ScreenUpdating = False
    Set wksLastActive = ThisWorkbook.ActiveSheet
    For Each wksSheet In ThisWorkbook.Worksheets
        Set rngRange = wksSheet.UsedRange
        If Not rngRange Is Nothing Then
            VarArr = rngRange.Formula
                If IsArray(VarArr) Then
                    wksSheet.Activate
                    For lngR = LBound(VarArr) To UBound(VarArr)
                        For lngC = LBound(VarArr) To UBound(VarArr, 2)
                            If Not IsEmpty(VarArr(lngR, lngC)) Then
                                If UCase(VarArr(lngR, lngC)) Like “*” & UCase(strFormula) & “*” Then
                                        If wksSheet.Cells(lngR, lngC).HasFormula Then
                                            VarArr(lngR, lngC) = Evaluate(VarArr(lngR, lngC))
                                            lngCount = lngCount + 1
                                            Else
                                            VarArr(lngR, lngC) = VarArr(lngR, lngC)
                                        End If
                                End If
                            End If
                        Next lngC
                    Next lngR
                    wksSheet.UsedRange.Value = VarArr
                End If
                Set rngRange = Nothing
        End If
    Next wksSheet
    wksLastActive.Activate
    Application.ScreenUpdating = True
    MsgBox strFormula & ” has been replaced in ” & lngCount & ” Cells”, vbInformation
End Sub
Most of time people have different requirements, e.g. they want to convert formulas to values on a single worksheet or in a selected range. but this code is not so dynamic, but this will give an idea on “how to” complete this task as faster as it can.

Calling UDFs by Hyperlink

Posted: June 5, 2013 in Excel, Excel VBA, VBA
Tags: , ,

So you are creating a dashboard and you are in a deep thought , thinking what should I add to make it more interactive
You have added scroll bar, dropdowns to refresh your charts and all what you can do with the excel, but may time you
feel like there should be a mouse hover event on worksheets ,so that you can make it smoother ,more interactive and more
pleasant for your eyes
Here I am sharing a trick people can use this smartly
There are two way we can call a VBA Function From Worksheets .
1) . Direct Call like excel native function (writing your function follow by “=” on worksheets)
    =MyFucntion()
2). Calling a function with in Excel Native Function Hyperlink()
So here is all about calling a UDF by Excel Hyperlink() function. Here we go.
First of all create a function in VBA
1) . Go to to VBE : Press ALT+F11
2) Insert a Module : Press Alt + I + M
3) Write a Function there like this :
    Function ShowAddress(rngRange As Range)
        MsgBox rngRange.Address
    End Function
then switch to Excel and write a formula like :
    =HYPERLINK(ShowAddress(C28),””)
here I am passing a range to UDF to see the cell address in a massage box
when we do things like this we need to pass the cell address to UDF in which cell
Formula is being applied , like if I am putting formula in A1 then I will pass A1 in
UDF with in hyperlink
when you will apply this Function in Range A1 and fill down or fill right in some cells. Then
Move your mouse on that cells ., you will see the cell address in a massage box
Thank You for reading
Rajan verma

hi Guys,
it took my lot of time to create home/Index tab to navigate in excel workbook, i always need it in most of dashboards ,dont you?
You can set any shape style default by right click on the shapes, it will work accordingly.
 Image
here is the code to create index : 
Sub CreateIndex()
    ‘–Code by Rajan
    Dim WksHomeTab As Worksheet
    Dim wksSheet As Worksheet
    Dim lngCOunter As Long
    lngCOunter = 0
    Set WksHomeTab = ThisWorkbook.Worksheets.Add
    With WksHomeTab
        .Name = “Home”
        For Each wksSheet In ThisWorkbook.Worksheets
            If wksSheet.Name <> “Home” Then
                .Range(“C4″).Offset(lngCOunter).Value = wksSheet.Name
                lngCOunter = lngCOunter + 1
            End If
        Next wksSheet
        .Range(“C4″).CurrentRegion.EntireRow.RowHeight = 25
        .Range(“C4″).Resize(, 2).EntireColumn.ColumnWidth = 30
        InsertShape WksHomeTab
        ActiveWindow.DisplayGridlines = False
        .Protect
    End With
End Sub
Sub InsertShape(wksHome As Worksheet)
    Dim rngCell As Range
    Dim ShpShape As Shape
    For Each rngCell In wksHome.Range(“C4″).CurrentRegion
        Set ShpShape = wksHome.Shapes.AddShape(msoShapeRectangle, rngCell.Offset(, 1).Left + 5, rngCell.Offset(, 1).Top + 5, 90, 20)
        ShpShape.TextFrame.Characters.Text = “View”
        ShpShape.TextFrame.HorizontalAlignment = xlHAlignCenter
        wksHome.Hyperlinks.Add ShpShape, “”, “‘” & rngCell.Value & “‘!A1″, “Click”, “”
        ShpShape.Locked = False
    Next rngCell
    Set ShpShape = wksHome.Shapes.AddShape(msoShapeFrame, wksHome.Range(“B1″).Top, wksHome.Range(“B1″).Left, wksHome.Range(“E1″).Left – wksHome.Range(“B1″).Left, wksHome.Range(“C4″).End(xlDown).Offset(2).Top – wksHome.Range(“B1″).Top)
    With ShpShape
        .Select
        Selection.ShapeRange.Adjustments.Item(1) = 0.06063
        Selection.ShapeRange.Adjustments.Item(1) = 0.05143
        .Top = wksHome.Range(“B2″).Top
        .Left = wksHome.Range(“B2″).Left
    End With
End Sub
you can download .xlsm from here
Thanks For Reading

Aside  —  Posted: March 1, 2013 in VBA
Tags: , , ,

Change Hyperlink Screentip

Posted: February 27, 2013 in VBA
Tags: , ,

It may take lot of time to change screen tip of each hyperlink in Excel, here is a code can do in few seconds
here you go :
Sub ChangeHyperLinkSceenTipOnAllShape()
    ‘—————————————–
    ‘–This Procedure will change screenTip
    ‘  of Cells and Shapes in ActiveSheet
    ‘—————————————–
    Dim wksSheet As Worksheet
    Dim shpShape As Shape
    Dim objHyperLink As Hyperlink
    Dim StrScreenTip As String
    StrScreenTip = InputBox(“Enter the Screen Tip”)
    If MsgBox(“Press Yes to Change Screentip of Cells Hyperlinks” & vbCrLf & _
              “Press No to Change Screentip on Shapes Hyperlinks”, vbYesNoCancel) = vbYes Then
        For Each objHyperLink In ActiveSheet.Hyperlinks
            If TypeName(objHyperLink.Parent) = “Range” Then
                objHyperLink.ScreenTip = StrScreenTip
            End If
        Next objHyperLink
    Else
        For Each objHyperLink In ActiveSheet.Hyperlinks
            If TypeName(objHyperLink.Parent) = “Shape” Then
                objHyperLink.ScreenTip = StrScreenTip
            End If
        Next objHyperLink
    End If
End Sub

Array Class

Posted: December 19, 2012 in Array, Array VBA, VBA
Tags: , , , , ,

Although VBA is a great language to manipulate office objects accordingly, but when it came to array handling  there are lack of method to handle array,

To resolve some of problems i collect and create some method and properties, see the content listed below which you can find in the class module .

Functions available in My Class Module for array handling .

Function Name Description Return Type
Function Offset By This Function You can Extract any Part of an Array.. It works like Excel Offset function Array Class Object
Function FilterArray as name implies , you can Filter array by this function Array Class Object
Function Sort You can sort an array . ACS and DESC order Array Class Object
Function IsArrayFilled you can check weather array is empty or not True/False
Function IsArray2Dimensional Return True if array is 2 D True/False
Function CombineArray Most Important Function to Combine Two Array, Either by Rows or Columns Array Class Object
Function Rows you can Extract a particular Row from an Array Array Class Object
Function Columns you can Extract a particular Columns  from an Array Array Class Object
Function Transpose Just Using Normal VBA Transpose Function to Transpose Array. Limited as VBA Transpose Array Class Object
Function GetUnique You can Get Unique Array List by this Function Array Class Object
Function CopyFromRecordset you can assign an Object input Array from a Recordset Nothing

you can find some properties of an Array object’s Listed below :

Count Read only Return Total Element Count of an array
ColumnsCount Read only Return Columns Count of An array
RowsCount Read only Returns Row Count of an Array
HTMLBody Read only Return HTML Body of an Array Table
How to Use the Class Object:
Sub HowToUseClassArray()
    ‘Create an object of Array Class
    Dim objArray As New ClsArray
    Dim VarResultArray
    ‘Filling Created Object Array
    objArray.InputArray = Range(“A1″).CurrentRegion
    VarResultArray = objArray.GetUnique.InputArray
End Sub
Thanks for Reading
Rajan Verma