Most useful UDFs 1

[N1GHTEYES]

It seems like it has been a while since there was a general question, so here goes...

What do you find are your most used and useful user-defined functions?

To get the ball rolling, here is my list:

Name: AL_ApTempP
Args: (ByVal photance As Double, ByVal L1 As Double, ByVal L2 As Double) As Double
Desc: Calculates the apparent temperature of a source of specified photance over the specified waveband L1 to L2. L1 and L2 are specified in microns.

Name: AL_ApTempR
Args: (ByVal radiance As Double, ByVal L1 As Double, ByVal L2 As Double) As Double
Desc: Calculates the apparent temperature of a source of specified radiance over the specified waveband L1 to L2. L1 and L2 are specified in microns.

Name: AL_Concat
Args: (rng As Variant, Optional sepchar As Variant, Optional IsAscii As Variant) As String
Desc: This function joins the contents of all the cells in rng into one output string, optionaly separated by sepchar. If sepchar is numeric and IsAscii is set true, the separation character is the Ascii char denoted by the numeric value sepchar.

Name: AL_CountUnique
Args: (rng As range) As Long
Desc: Counts the number of cells in the supplied range having unique values. Empty cells are included in the count.

Name: AL_Fourier
Args: (inrng As range, Optional inverse As Boolean = False) As Variant
Desc: Returns the forward or inverse fourier transform of the input range

Name: AL_GetVal
Args: (Source As String, Optional pos As Integer, Optional sepchar As Variant)
Desc: Returns the numerical value at position "pos" in the string list delimited by the character "sepchar" Can be used in conjunction with LSQcoefs()

Name: AL_Iplate
Args: (inlist As range, outlist As range, inval As Variant) As Variant
Desc: Returns the value interpolated from outlist at the position interpolated in inlist by inval. The gradients of inlist and outlist may be positive or negative, but the signs of the gradients must be constant, I.e. both functions should be monotonic..

Name: AL_Like
Args: (teststr As String, matchstring As String) As Boolean
Desc: Mimics the VBA "Like" function - includes use of ? and * wildcards

Name: AL_LikeCount
Args: (inlist As range, checkstring As String) As Long
Desc: Returns the number of cells in "inlist" which are "like" the "checkstring"

Name: AL_LikeList
Args: (inlist As range, checkstring As String) As Variant
Desc: Generates an array output consisting of the values in those cells in "inlist" which are "like" the "checkstring"

Name: AL_LiveSort_1D
Args: (data As range, Optional HiToLow As Variant = False, Optional Showtiming As Variant = False) As Variant
Desc: This function should be entered as an array formula. It returns a sorted version of the specified range. Default sort order is low to high.

Name: AL_LSQcoefs
Args: (order As Integer, xvals As range, yvals As range, Optional sigmalimit As Variant) As String
Desc: Returns a comma-delimited string holding the polynomial coeficients for the least-squares fit of order "order" for the coordinates given in xvals and yvals.

Name: AL_Photance
Args: (lo As Double, hi As Double, Temp As Double, Optional Steps As Variant = 1000) As Variant
Desc: Returns the photance calculated over the given waveband (L1 to L2 in microns) of a blackbody at the specified temperature (in K)

Name: AL_PolyCalc
Args: (X As Double, coefs As range) As Double
Desc: Returns the value of the polynomial defined by the coefficients in the range coefs, evaluated at the point X

Name: AL_Radiance
Args: (lo As Double, hi As Double, Temp As Single, Optional Steps As Variant = 1000) As Variant
Desc: Returns the radiance (W/m^2/Str) calculated over the given waveband (L1 to L2 in microns) of a blackbody at the specified temperature (in K)

Name: AL_sApTempP
Args: (radiance As Double, Spectrum As Range, Tx As Range) as Variant
Desc: Returns the apparent temperature of a body with the given photance in the specified spectrum

Name: AL_sApTempR
Args: photance As Double, Spectrum As Range, Tx As Range) as Variant
Desc: Returns the apparent temperature (K) of a body with the given photance in the specified spectrum

Name: AL_sPhotance
Args: (Spectrum As Range, Tx As Range, temp As Double) As Variant
Desc: Returns the spectral Photance (Ph/s/m^2/str), calculated for the given spectral response

Name: AL_sRadiance
Args: (Spectrum As Range, Tx As Range, temp As Double) As Variant
Desc: Returns the spectral Radiance (W/m^2/str), calculated for the given spectral response

Tony

 

[SkipVought]

My UDFs, nearly 100, are almost all database functions via ADODB objects.

I also have a MakeList(range,delimiter,separator) that seems much like your AL_Concat, that I use primarily to load an SQL IN statement.


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[N1GHTEYES]

I guess the question applies to macros too. I use a bunch of them behind a toolbar. The 3 most useful are:

Name: AL_Colour_by_3rd_data_set
Desc: Colours the points of an xy chart by the values in a 3rd range

Name: AL_List_Names
Desc: Creates a table, at a user-selected location, of all the names in the workbook, plus their definitions and current values

Name: AL_ReLinkHyperlinks
Desc: Fixes all the broken hyperlinks on a worksheet if the source files have been moved.


Who's next?

I think that seeing the uses to which other people put their VBA, might inspire me & other readers to use it in areas not previously considered, making for more capable tools.

Tony

 

[N1GHTEYES]

Skip,

Just curious, but what is the difference between "delimiter" and "separator"?

Tony

 

[SkipVought]

Produce a list of eMail Addresses: need APOSTROPHY delimiters and SEMICOLON separators: 'SkipVought@Mailserver.com';'Other@SomeOther.com'

Produce a list of numeric values, need NO delimiter and COMMA separator" 123,456

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[N1GHTEYES]

To complete the set...
The following are neither UDFs nor Macros, but I call them quite a lot in both of the above.

This one is used in the middle of a macro to get from the user a range of cells he needs to specify:

Function get_user_range_selection(Optional usermessage As Variant = "Select Cells") As Range
'
' Interrogates user for a range selection and
' returns the selected range
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set get_user_range_selection = Application.InputBox(Prompt:=usermessage, Type:=8)
End Function

and

This one enables various other subs to take ranges and array of unknown dimensions as arguments and process them appropriately:

Public Function Dims(data As Variant) As Integer
'*****************************************************************************************
'  1. DESCRIPTION of Dims
'
'   This function returns the number of dimensions in "data".  Data may be an array or a range.
'
'*****************************************************************
On Error GoTo errfound
Dim i As Integer, test As Integer

If TypeName(data) = "Range" Then
    Do
        i = i + 1
        test = LBound(data.Value2, i)
    Loop
Else
    Do
        i = i + 1
        test = LBound(data, i)
    Loop
End If
errfound:
Dims = i - 1
Err.Clear
End Function

I started the thread because I thought that seeing what others find useful might be a good way to expand my (and other readers') perspective on uses to which VBA might be put. I also thought that seeing what more experienced members actually find useful might be a useful insight for less experienced members.

Has anybody else any favourites they want to mention?

Tony

 

[Gruuuu]

My most useful UDFs are ones that are fairly particular to my business needs.

Function fiscalyear(ByVal date_ As Date)

Dim firstday As Date

firstday = firstdayofFY(date_)

If date_ < firstday And Year(date_) > Year(firstday) Then
    fiscalyear = Year(date_)
Else
    fiscalyear = Year(firstday) + 1
End If


End Function

Function fiscalperiod(ByVal date_ As Date)
fiscalperiod = Application.WorksheetFunction.Ceiling(fiscalweeks(date_) / 4, 1)
If fiscalweeks(date_) = 53 Then
    fiscalperiod = 13
End If
End Function

Function fiscalweek(ByVal date_ As Date)
Dim weeks As Date
weeks = fiscalweeks(date_)
fiscalweek = weeks Mod 4
If fiscalweek = 0 Then
    fiscalweek = 4
End If
If weeks = 53 Then
    fiscalweek = 5
End If
End Function

Function fiscalweeks(ByVal date_ As Date)
fiscalweeks = Application.WorksheetFunction.Floor((date_ _
              - firstdayofFY(date_)) / 7, 1) + 1
End Function

Function firstdayofFY(ByVal date_ As Date)

firstdayofFY = DateSerial(Year(date_), [red]3, 1[/red] _
             - Weekday(DateSerial(Year(date_), 3, 1)) + 1)

If date_ < firstdayofFY Then
    firstdayofFY = DateSerial(Year(date_) - 1, [red]3, 1[/red] _
                 - Weekday(DateSerial(Year(date_) - 1, [red]3, 1[/red])) + 1)
End If
End Function

Function wedate(ByVal date_ As Date)

wedate = date_ + 7 - Weekday(date_)
End Function

Just to return the Fiscal Calendar equivalents of a Natural Calendar Date. The Fiscal Year pivots on March 1st, but jumps around based on how close March 1st is to the Saturday on or before it. Our fiscal weeks are referred to by the Saturday that ends them. I didn't even create functions for the periods or quarters.

I have other functions that I find incredibly useful to myself. But most people will not find them as helpful. I get the feeling that most UDFs are going to be this way.

 

[N1GHTEYES]

I agree - after all, how many people are going to want to know the radiance of a blackbody in a given waveband at a given temperature? But stuff like concatenation (which Skip mentioned) and get-user-range-selection(), are probably quite universal.

Tony

 

[electricpete]

As an engineer, a UDF that I use the most frequently is getformula:

Public Function getformula(mycell As Range) As String
    getformula = mycell.Formula
End Function

This can help a lot in making a spreadsheet more self-documenting.... such that you can sometimes cut/paste a portion of the spreadsheet into a report and someone reading the report can understand how the calculation was done (for relatively simple calculations). Also toward the same end you need to use defined names, preferably with name placed to the left of cell it described, then assign using insert/name/create/left-column

 

[electricpete]

Name: AL_List_Names
Desc: Creates a table, at a user-selected location, of all the names in the workbook, plus their definitions and current values

That would be handy. Can you post the code.

 

[SkipVought]

Pete,

That can simply be done with

97-2003
Insert > Name > Paste

2007 +
Formulas > Defined Names > Use in Formula > Paste Names

As far as VALUES go, that is only valid for SINGLE CELL named ranges, and you can use the INDIRECT function to get single values

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[electricpete]

That can simply be done with

97-2003
Insert > Name > Paste

Insert > Name > Paste is not an option in my excel 2000. What I described works fine... I have no idea what you are trying to simplify.

As far as VALUES go, that is only valid for SINGLE CELL named ranges, and you can use the INDIRECT function to get single values

Yes, you are correct - only valid for single cell named range.

 

[SkipVought]

I was replying to your post of 10 Apr 11 13:28, requesting code.

I guess that the 2003 feature is not available in 2000.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[electricpete]

ok, I see Insert > Name > Paste is an option.... one of many ways to create a named range. The method I described gives a named range with it's name visible directly in the cell to the left of it. That is what I was suggesting... works great for me because of the self-documenting nature I described above.

 

[electricpete]

I was replying to your post of 10 Apr 11 13:28, requesting code.

I guess that the 2003 feature is not available in 2000.

Thanks for the clarification. I definitely misunderstood your comment. The feature is available, but brings up a dialogue box, not a table. And does not list addresses and values.

 

[SkipVought]

Here's what PASTE NAMES does in one of the workbooks I happen to working on today...
[tt]
comment_field =Factors!$G$2:$G$6
Comment_Header =IndInvDashboard!$AV$3:$AZ$3
comment_source =Factors!$H$2:$H$6
Comments =IndInvDashboard!$AY$4:$AY$306
Database =IndInvDashboard!$A$3:$L$102
Description =IndInvDashboard!$C$4:$C$306
FileDate =FileList!$B$2:$B$451
FileName =FileList!$A$2:$A$451
FilePath =Factors!$A$1
FileRptName =FileList!$C$2:$C$451
Frozen =IndInvDashboard!$N$4:$N$306
Grp_Code =IndInvDashboard!$F$4:$F$306
In_Transit =IndInvDashboard!$P$4:$P$306
Ind =IndInvDashboard!$A$4:$A$306
IndInvAnchor =IndInvDashboard!$A$3
Lead_Time =IndInvDashboard!$G$4:$G$306
Max_OTI =IndInvDashboard!$H$4:$H$306
Msg =IndInvDashboard!$G$1
Neg =IndInvDashboard!$J$4:$J$306
O_H =IndInvDashboard!$M$4:$M$306
On_Dock =IndInvDashboard!$O$4:$O$306
P_D =IndInvDashboard!$Q$4:$Q$306
Part =IndInvDashboard!$B$4:$B$306
Procurement_Hot_column =IndInvDashboard!$AZ$4:$AZ$306
Procurement_Notes =IndInvDashboard!$AX$4:$AX$306
Program_review_OTI =IndInvDashboard!$AW$4:$AW$306
Qty =IndInvDashboard!$I$4:$I$306
Resp_Code =IndInvDashboard!$D$4:$D$306
RptName =ReportList!$A$2:$A$91
SelectedFileName =Factors!$A$3
SelectedPN =Factors!$A$5
SelectedRPT =IndInvDashboard!$A$1
SelectedRPT_DTE =IndInvDashboard!$E$1
Supporting =IndInvDashboard!$AV$4:$AV$306
Type =IndInvDashboard!$L$4:$L$306
Updated =Factors!$A$7
Vendor =IndInvDashboard!$K$4:$K$306
[/tt]

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[electricpete]

That is handy. Thanks Skip!

 

[N1GHTEYES]

Sorry for the delay (I have been otherwise occupied for a few days). In response to electricpete's request, (if it is still needed after Skip's response) here is the code:

Public Sub AL_ListNames()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description:
'This sub creates a list of all the names and named ranges in th workbook,
'together with a definition of what each range refers to.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim sinkrange As Range
Dim reply As Variant
Dim msg As String
Dim r As Integer, c As Integer
Dim calcmethod As Variant

'provide explanation of what will happen & give user chance to quit
msg = "This procedure will list all of the ranges in this workbook, together with their definitions."
msg = msg & Chr(13) & "You will be asked to select a range where you want the list to be written."
msg = msg & Chr(13) & "Select OK to continue or Cancel to quit."

reply = MsgBox(msg, vbOKCancel)
If reply = vbOK Then
    'get the range where the user wants to start writing the results
    Set sinkrange = get_user_range_selection()
'    r = sinkrange.Row
'    c = sinkrange.Column
    r = 1
    
    'get the names and write them to the spreadsheet
    Dim nm As Name
    On Error Resume Next
    Dim cnt As Long
    calcmethod = Application.Calculation
    Application.Calculation = xlCalculationManual
    sinkrange(r, 1) = "Name"
    sinkrange(r, 2) = "Definition"
    sinkrange(r, 3) = "Value"
    For Each nm In ActiveWorkbook.Names
       r = r + 1
       sinkrange(r, 1) = nm.Name
       sinkrange(r, 2) = "'" & nm.RefersTo
       cnt = nm.RefersToRange.count
       If Err.Number <> 0 Or nm.RefersToRange.count > 1 Then
            sinkrange(r, 3) = "N/A"
            Err.Clear
       Else
            sinkrange(r, 3) = nm.Value
       End If
    Next nm
    Application.Calculation = calcmethod
End If
End Sub

I use it for practical purposes, e.g. to give me a visual reminder of the current names when constructing an interrelated set of named formulae, and to aid in documenting what a workbook does.

Tony