## Sort data by excel formula

Posted: June 28, 2014 in VBA
Tags: , , , , , , ,

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

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.

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

Rajan verma

7838100659

## How to delete worksheets without Loop.

Posted: March 3, 2014 in 1D Array, 2D Array, Array, Evaluate
Tags: , ,

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.

Rajan verma

## Send E-mail using Other account by outlook.

Posted: September 29, 2013 in VBA
Tags: , ,

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

## Convert Specific formula to value :

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

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.

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
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 :
End Function
then switch to Excel and write a formula like :
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
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
Rajan verma

## Indexer

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.

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
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
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
.Top = wksHome.Range(“B2″).Top
.Left = wksHome.Range(“B2″).Left
End With
End Sub

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

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 :
‘—————————————–
‘–This Procedure will change screenTip
‘  of Cells and Shapes in ActiveSheet
‘—————————————–
Dim wksSheet As Worksheet
Dim shpShape As Shape
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