Saturday, January 16, 2010

Excel Formula : Closest Match

Arun Singla one of my blog reader has sent me Excel Formula in response to my previous post Custom Function : Excel Closest Match using VBA.

Formula sent by Arun gives similar results as achieved by Custom Function using VBA. I am sharing the formula with you.

For getting less than equal to value
=IF(COUNTIF(Data,Target)>=1,Target,SMALL(Data,COUNTIF(Data,"<"&Target)))
For getting greater than equal to value
=IF(COUNTIF(Data,Target)>=1,Target,LARGE(Data,COUNTIF(Data,">"&Target)))

In above formula : Data is unsorted data range name, target is the named range having target value.

Now let me explain how does this formula works. I will explain first formula which calculates less than equal to value.

Step 1 - Formula calculates the number of values matching target value using countif function of excel. COUNTIF(Data,Target) gives the total number of values matching exactly with the target. In case you get even one value matching with the target, you return the target as closest match, no need for further working.

Step 2 - In case formula does not get matching value at step 1 , it moves to find the closest match. SMALL(Data,COUNTIF(Data,"<"&Target)) Returns the k-th smallest value in a data set. COUNTIF(Data,"<"&Target) gives us total number of data points less than target. We are using this as k-th smallest value which is closest match less than the target value. I hope this explanation is not confusing to you. Check out the file with this formula to find closest match in excel to understand it better.

Thursday, January 14, 2010

Custom Function : Excel Closest Match using VBA

Some days back I got a mail from Kevin asking for how to get closest match in a list sorted in acending order

Hi Yogesh, is there a way for me to find the
closest match (greater than or equal to) to
a value in a list? The list is sorted in
ascending order and cannot be changed.
Regards,
Kevin

I responded to him with a Custom Function capable to Finding Closest Match as per his requirement. This worked as the list was sorted in ascending order. He sent me a thanks note for this.

However this left certain questions in my mind such as

1. What if the list is not sorted, Custom function should be able to do this in unsorted list.

2. He wanted greater than equal to value, however it should be able to handle less than equal to value also

With these things in my mind I worked out another custom function which works with unsorted data range and is capable of finding both type of closest match in excel.

I am sharing updated Custom Function with all of you. You will need to copy this code to regular VBA module of your workbook

Function cmatch(ByVal n, l As Range, Optional Switch As Integer = 1)
'**************************************************************************************
'* Custom Function by Yogesh Gupta , yogesh@yogeshguptaonline.com *
'* Custom Function to find Closest Match in an unsorted data *
'* use Switch value as -1 in case you want less than equal to closest match *
'* Default value for Switch is 1, and will find greater than equal to closest match *
'**************************************************************************************

If Switch = 1 Then ' This will get greater than equal to value

a = Application.Max(l)
If a < n Then ' Error in case list does not have value greater than or equal to n
cmatch = "#N/A"
Else
For Each c In l
If c >= n Then
If c < a Then a = c
End If
Next c
cmatch = a
End If

ElseIf Switch = -1 Then ' This will get less than equal to value

a = Application.Min(l)
If a > n Then ' Error in case list does not have value less than or equal to n
cmatch = "#N/A"
Else

For Each c In l
If c <= n Then
If c > a Then a = c
End If
Next c

cmatch = a
End If

Else

cmatch = "#N/A" ' Error in case of Invalid Input

End If

End Function


Download Excel file with Custom Function to Find Closest Match to see how it works

Friday, January 1, 2010

Excel Macros : Excel Date Picker

This is first post of the year 2010, I wish all my blog readers a very happy and prospurous year. Today I am sharing Excel Date Picker Utility with you. Following picture will demonstrate some to the capabilities of this utility.

Photobucket



This utility will help you with following

1. In case you select a cell with date, or select any cell around the cell with a date. It will show floating button on the left side of the cell. If you click on the floating button it will show popup calender.
2. In case the cell already has a date , the calendar will show same date by default, else it will show current date.
3. You can jump the months by click on the month value on the popup calendar.
4. Click on the year will show spin buttons next to it and you can change year easily with spin buttons.
5. When you click on the date in popup calander, it will insert date clicked to the selected cell
6. You can also use Ctrl+Shift+d to show popup calender on your screen.
7. In case you get pop up calander and you do not want to click any date, just press Esc to close the pou up calendar.

This utility could be usefull in following ways

1. Many people end up entering date in text format as some time it is difficult to enter the date in correct computer readable format. With the popup calander, system takes care of the proper date entry.
2. Some times you have to get data from other users and you want them to enter dates in proper format so that rest of the worksheet can use those date inputs. With this utility you can be assured about this issue.

You may figure out many more usage based on your needs. The VBA code for Excel date Picker is available in the downloadable file. You can further modify the code as per your needs.

Now how to use this Excel Date Picker Utility



1. Download file and save it as Excel Addin on your machine.
2. You will need to copy this code to worksheet module of your workbook.

You will need to add this code to show the Floating button. This code will creat the button in case it does not exist on it. All other features like cell menu on right click and popup calender on Ctrl+Shift+d will be available in case you do not add this code by saving download able file as Excel Addin on your machine. I am suggesting this because I still need to learn how to trigger worksheet selection change event with a vba code in addin.


Private Sub FloatingButton_Click()
Calander.Show
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Application.CutCopyMode = 1 Then
Exit Sub
ElseIf Target.Cells.Count > 1 Then
Exit Sub
Else

Set r = Target
Hasdate = 0

For x = -1 To 1
For y = -1 To 1

On Error GoTo Etrap1

If IsDate(r.Offset(x, y)) Then
Hasdate = 1
Exit For
End If
Rsume1:
Next y
If Hasdate = 1 Then Exit For
Rsume:
Next x

If Hasdate = 1 Then

FloatingButton.Left = r.Offset(0, 1).Left
FloatingButton.Top = r.Top
FloatingButton.Visible = True

Else

If Not FloatingButton.Visible = False Then
FloatingButton.Visible = False
End If

End If

Exit Sub

End If

Etrap1:
If r.Row = 1 Then
Resume Rsume
ElseIf r.Column = 1 Then
Resume Rsume1
End If


End Sub

Private Sub Worksheet_Activate()
Dim s As String
On Error Resume Next
s = ActiveSheet.FloatingButton.Caption
If Err.Number <> 0 Then
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=147.75, Top:=34.5, Width:=15.75, Height:= _
15.75).Select

Selection.Name = "FloatingButton"
ActiveSheet.OLEObjects("FloatingButton").Object.Caption = ""
ActiveSheet.OLEObjects("FloatingButton").Object.BackColor = &H80000005
Range("A1").Select
FloatingButton.Visible = False
End If
On Error GoTo 0

End Sub


However this will not work on the files you send to other users. In that case you need to builtin the entire utility into the file you are sending out.

Following steps will help you to do this.

1. You will need to copy this code to workbook module of your workbook

Private Sub Workbook_Open()
Dim NewControl As CommandBarControl
Application.OnKey "+^{D}", "Module1.ShowCalander"
On Error Resume Next
Application.CommandBars("Cell").Controls("Show Date Picker").Delete
On Error GoTo 0
Set NewControl = Application.CommandBars("Cell").Controls.Add
With NewControl
.Caption = "Show Date Picker"
.OnAction = "Module1.ShowCalander"
.BeginGroup = True
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Cell").Controls("Show Date Picker").Delete
End Sub


2. You will need to copy this code to regular VBA module - Module1 of your workbook

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Private Const GWL_STYLE As Long = (-16)
Private wHandle As Long

Sub ShowCalander()
Calander.Show
End Sub


3. Move form named calander from the downloadable file to your file.

With these steps you can send the file to other users and it will work in similar way as it works on your machine.

In addition you can force users to enable macros while using your file

Download file with Excel Date Picker Utility