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.

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

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.





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