Excel provides SMALL and LARGE formula to get sorted numeric values , but sometime we need our string/text data to be sorted by formula only.

Though, there is an inbuilt sorting feature available in excel, but here I am going to demonstrate a formula.

So, Lets say you have your data list in Range “A1:A10″, Better to create a name instead of using direct reference into the formula. so I have create a name range that is “myList”

=INDEX(MyList,MATCH(SMALL(MMULT(N(MyList>TRANSPOSE(MyList)),ROW(MyList)*0+1),ROW(MyList)),MMULT(N(MyList>TRANSPOSE(MyList)),ROW(MyList)*0+1),0))

 

It might be looking a long formula to some of you,but believe me it is not,  because red part is same. Ok,lets evaluate this.

The base inside this formula is  this ,

=N(MyList>TRANSPOSE(MyList))

this formula compares each value with each value in the list and create a two-dimensional array

 T1

 if you look at the 0 in B2 it mean that 10 in A2 is not greater than 10 in B1, and if you look at 1 in B3 , it means 12 in A2 is greater than B1, and so on. the next step is to sum this array by rows. So we will MMULT here with another array. See the  formula down below to get that second array, this should have the same number of row element as our first array but all the element would be 1

=ROW(MyList)*0+1   = {1;1;1;1;1;1;1;1;1}

and now we have two matrix to multiply , so here we use MMULT() function

=MMULT(N(MyList>TRANSPOSE(MyList)),ROW(MyList)*0+1)

After multiply that two matrix it will give a result like this table. 

t2

Now we just need to sort these numbers, and we will use SMALL() function to do that. So here is the next formula

=SMALL(MMULT(N(MyList>TRANSPOSE(MyList)),ROW(MyList)*0+1),ROW(MyList))

this will return these sorted numbers

={0;1;2;3;4;5;6;7;8}

Next , we need to match the correct index for all these elements from the above list.

=MATCH(SMALL(MMULT(N(MyList>TRANSPOSE(MyList)),ROW(MyList)*0+1),ROW(MyList)),MMULT(N(MyList>TRANSPOSE(MyList)),ROW(MyList)*0+1),0)

this will return these index numbers

={3;1;2;6;7;8;4;5;9}

Now we got the index and we just need to get the Text from our original list

=INDEX(MyList,MATCH(SMALL(MMULT(N(MyList>TRANSPOSE(MyList)),ROW(MyList)*0+1),ROW(MyList)),MMULT(N(MyList>TRANSPOSE(MyList)),ROW(MyList)*0+1),0))


and here is your sorted list

t3

 

Thanks for reading

Rajan verma

7838100659


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