Does Find work in a worksheet UDF??

[Loomah]

Hi All!

Am I just being dense/stupid or does Find not work when in a function?

The background is that I need to be able to calculate the median value of a cells depending on a criteria (well 2 actually!) The ideal function would be DMEDIAN but it doesn't exist in xl97!!

So the following is the first almost working iteration of my own UDF for the purpose.

I need to find the median value in a range of data where (in this case) the first critera is "F" and the second criteria is 1.

on a worksheet
=DynaMedian(C2:C7,A2:A7,"F",B2:B7,1)
where c2:c7 hold the data to clac the median on
a2:a7 hold the first criteria (A-F)
b2:b7 hold the second criteria(1-5)

Function DynaMedian(EvalRng As Range, CritRng1 As Range, Crit1 As Variant, CritRng2 As Range, Crit2 As Variant) As Double
Dim myArr() As Variant
Dim Count As Integer
Dim found As Range
Dim firstaddress As String

With CritRng1.Cells
    Set found = .Find(Crit1, LookIn:=xlValues)
        If Not found Is Nothing Then
            firstaddress = found.Address
    
            Do
                If Cells(found.Row, CritRng2.Column) = Crit2 Then
                    ReDim Preserve myArr(Count)
                    myArr(Count) = Cells(found.Row, EvalRng.Column).Value
                    Count = Count + 1
                End If
                Set found = .FindNext(found)
            Loop While Not found Is Nothing And found.Address <> firstaddress
        End If
End With
DynaMedian = WorksheetFunction.Median(myArr)
End Function

Doesn't work - found always evaluates to Nothing!

However if the above function is called like so

Sub a()
Debug.Print DynaMedian(Range("C2:c7"), Range("A2:A7"), "F", Range("B2:B7"), 1)
End Sub

Works just fine!!

Any ideas, suggestions, bits I've missed, alternatives REALLY appreciated!

Oh, BTW, looping the cells isn't a realistic option as the real data set will be 25k+ rows and the function will be called at least 30 times!

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[xlbo]

Loomah - FIND works in XP/2003 but I do seem to recall having issues with it in a UDF - might have a search cos I think I posted a question about it...

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[DaleWatson123321]

Loomah,

I've created a solution that works and should be as fast as possible - as it uses Excel's database functionality.

Here's how I set my model. You might want to first follow this to create an independent model, and then reference it to fit to your application. I'm also providing detail that you possibly don't require because of your experience, but the detail is also intended for others with less experience who might find this useful.

1a) Sheet1 - change the tab name to "Database". (don't enter the quotation marks in any of the following instructions)
1b) On row 1, I have the following field names: A1: “Col_1”, B1: “Col_2”, C1: Col_3”.

2) Create the range name "data" for the range A1:C30000

My method for creating range names
- Highlight the range
- Hold down <Ctrl> and hit <F3>
- Type the name
- Hit <Enter>

3a) Sheet2 - change the tab name to "Criteria".
3b) Sheet3 – change the tab name to “Extraction”.

4a) Cell A3, entered the label "crit". On sheets that are normally “out of sight” from the end-user, I enter a label next to the cell(s) where I assign range names. I find this useful for later reference. Otherwise it’s more difficult to know where your range names are located.

4b) In B3, copy the field name used in the database for your “F” criteria – “Col_1”
4c) In B4, enter “F”.
4d) In C3, copy the field name used in the database for your “1” criteria – “Col_2”
4e) In C4, enter “1”.
4f) Highlight B3:C4, and assign the range name “crit”.

5) In A8, enter the label “MEDIAN NUMBER”.

6a) In A9, enter the label “cnt”.
6b) In B9, create the range name “cnt”.
6c) In B9, enter this formula: =DCOUNTA(data,3,crit)
6d In C9, enter the label “record count”

7a) In A10, enter the label “even_num”
7b) In B10, create the range name “even_num”.
7c) In B10, enter this formula: =IF(MOD(cnt/2,1)=0,1,0)
7d) In C10, enter this label “0 if count EVEN, 1 if ODD”

8a) In A11, enter the label “num_1”
8b) In B11, create the range name “num_1”.
8c) In B11, enter this formula: =(cnt/2)+1
8d) In C11, enter this label “adds 1 row to allow for field name”

9a) In A12, enter the label “num_2”
9b) In B12, create the range name “num_2”.
9c) In B12, enter this formula: =(cnt/2)+2
9d) In C12, enter this label “adds 1 more row to reference 2nd num”

10a) In A13, enter the label “med_1”
10b) In B13, create the range name “med_1”.
10c) In B13, enter this formula: =INDIRECT("Extraction!A"&TEXT(num_1,0))
10d) In C13, enter this label “median # if count is ODD”

11a) In A14, enter the label “med_2”
11b) In B14, create the range name “med_2”.
11c) In B14, enter this formula: =INDIRECT("Extraction!A"&TEXT(num_2,0))
11d) In C14, enter this label “if count is EVEN, formula below averages med_1, med_2”

12a) In A15, enter the label “med_num”
12b) In B15, create the range name “med_num”.
12c) In B15, enter this formula: =IF(even_num=1,AVERAGE(med_1,med_2),med_1)
12d) In C15, enter this label “uses either med_1 or avg of med_1,med_2”

13a) In A1 of the “Extraction” sheet, copy the field name from the column that contains the data on which the Median will be calculated – “Col_3”
13b) In A1, assign the range name “ext”.

14a) Activate the Visual Basic Editor: <Alt> F11> to activate,
14b) From the menu, choose: Insert – Module.
14c) On the right-side, copy and paste the following code

Sub Get_Median()
    Application.ScreenUpdating = False
    Extract_Data
    Sort_Data
    Application.ScreenUpdating = True
    MsgBox "Median is: " & [med_num].Value
End Sub

Sub Extract_Data()
    Application.ScreenUpdating = False
    Range("data").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:="crit", _
    CopyToRange:=Range("ext"), _
    Unique:=False
End Sub

Sub Sort_Data()
    Application.Goto Reference:="ext"
    ActiveCell.Offset(1, 0).Select
    FirstCell = ActiveCell.Address
    LastCell = Cells(65536, ActiveCell.Column).End(xlUp).Address
    sortdata = FirstCell & ":" & LastCell
    Range(sortdata).Select
    Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Application.Goto Reference:="R1C1"
End Sub

15) To exit the VB Editor, use <Alt> q

16a) From the “Forms” toolbar, click-and-drag the “button” icon to the “Extraction” sheet.
16b) In the “Assign Macro” window, assign “Get_Median” (If you don’t see, “Get Median”, change to “This Workbook” opposite “Macros in”).
16c) Change the button face to read “Get Median”.

17) BEFORE testing (by clicking the button), you’ll need to enter some data in your database. And of course to get results, you’ll need to have some of the records meeting your criteria – of having “F” in “Col_1”, “1” in “Col_2”. And you’ll also need to enter numbers in “Col_3”.

I hope this helps. ;-)

Regards, Dale Watson

 

[Loomah]

xlbo
thanks for having a look for me!

Dale
Two things:
1 Where've you been?
2 WOW!!

I'll have to have a look at this later on but at first glance I'm not 100% sure it'll be flexible enough.

To clafify, I'm in the middle of doing some costings for a Pay & Grading review in a fairly large organisation. The F and the 1 are 2 elements that combined will make up a "grade". Grades will go from A - F & 1 - 5 so that's 30 in total. The problem is that I'd need the median in each grade and if I were to change a group of individuals from A1 to C3 I'll need everything to flow through automatically as this would have an impact on the median for both A1 & C3.

It's getting messy to say the least!!


;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[DaleWatson123321]

Loomah,

I’ve modified the model to reflect the needs you’ve recently expressed. I believe the modified version completely meets your needs. The time it takes is 1 second to update the 30 Median numbers - based on the individual criteria and based on a database of 30,000 records.

Here are the additions to add: (IMPORTANT: These steps must be done AFTER the steps of my previous posting.)

1a) On the “Criteria” sheet, in A5, enter the label “l_n”
1b) in B5, assign the range name “l_n”
1c) in C5, enter the label “<this value is received via VBA from the Grades sheet”

2a) in B4, enter this formula: =LEFT(l_n,1)
2b) in C5, enter this formula: =RIGHT(l_n,1)

3) On the “Extraction” sheet, click on the column letter “A” to select the entire column, and then assign the range name “ext_colm”.

4a) Back on the “Criteria” sheet, in A20, enter the label “botm_row”.
4b) in B20, enter this formula: =COUNTA(ext_colm)
4c) in C20, enter this label “'used by VBA to determine last row of data extracted”

5) Insert a new worksheet, and change the tab to “Grades”.

6a) On the “Grades” sheet, in A3, enter the label “A_1”
6b) in B3, assign the range name “A_1”.

7) In A4, enter “A_2, in A5, enter “A_3”, in A6, enter “A_4”, in A7, enter “A_5”.

8) For A8:A12, repeat for B_1, B_2, B_3, B_4, B_5

9) and repeat for letters C, D, E, and F

10) I’ve created a matrix as an option to better display the results – as follows:
a) in D38, enter: A, B, C, D, E, F
b) in E2:I2, enter 1, 2, 3, 4, 5
c) fill the cells with formulas that reference the corresponding results that will be generated in Column B. For example, the formula in E3 will be =B3, formula in F3 will be =B4, etc.

11) Move your macro button to the “Grades” sheet.

12) Replace the (entire) previous code with the following revised code:

Sub Get_Medians()
    Application.ScreenUpdating = False
    Worksheets("Grades").Select
    [a_1].Select
    For i = 1 To 30
    [l_n].Value = ActiveCell.Offset(0, -1).Value
    Get_OneMedian
    ActiveCell.Value = [med_num].Value
    ActiveCell.Offset(1, 0).Activate
    Next i
    [a1].Select
    Application.ScreenUpdating = True
End Sub

Sub Get_OneMedian()
    Extract_Data
    recs = [cnt].Value
    If recs > 1 Then
    Sort_Data
    End If
End Sub

Sub Extract_Data()
    Application.ScreenUpdating = False
    Range("data").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:="crit", _
    CopyToRange:=Range("ext"), _
    Unique:=False
End Sub

Sub Sort_Data()
    TopRow = [ext].Offset(1, 0).Address
    BotmRow = "$A$" & [botm_row].Value
    rng = "Extraction!" & TopRow & ":" & BotmRow
    Range(rng).Name = "ext_range"
    [ext_range].Sort Key1:=[ext_range], Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

13) Right-click on the button, and assign the macro “Get_Medians”.

14) Modify the button face to read: “Get Medians”.

That’s all – except for populating the database and trying out the routine. On my PC, a P4 2.4Gh, it takes about 1 second to calculate the 30 Median numbers based on a 30,000 record database.

Hope this helps, Loomah. Please advise.

Regards, Dale Watson