Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

help with a logarithmic addition formula -- VBA Code 1

Status
Not open for further replies.

gxgeorge

IS-IT--Management
Feb 23, 2011
5
SE
log2.gif

Hi everybody, I need some guidance on how to make the above formula work.

I've been struggling with it for a couple of days now. I'm not a coder, but i tried to use different samples and tutorials i found online. Aparently is quite difficult to think out of the box and find the right algorithm. Any tips or help would be highly appreciated.

Down here you may see how i would start; unfortunately i don't have many ideas on how to continue...

[tt]'Logarithmic addition
Function loggadd(ti As Range, Li As Range) As Double

'Declare the range
Dim t As Range
Dim L As Range

'Get each element
For Each t In ti

'?????????????????????????????????

End Function [/tt]
 


hi,
I'm not a coder...
So why are you coding it, then?

Have you tried working it out using the formulas on the sheet? If it cannot be done on a sheet, it cannot be done in VBA either.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 



BTW, what actual limits are you working with?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Thanks for feedback SkipVought!

I need it as VBA to ease the work and automate the process.
Certainly you can fix it manually by typing a formula on the sheet, but this is simply not an efficient way of doing it as you always have to manipulate huge amounts of data (for example 1-2000 lines of data); besides using it on different data ranges is killing you. I have uploaded an excel file that contains this formula typed in manually. The file has got only 3 data lines just for simplification reasons. I add a printscreen as well.

My knowledge in coding is basic. I have read a lot and tried different things during the last week, but it hasn’t helped me much. I need tips/help on how to continue and if possible guidance and assistance throughout the whole process. I wrote the formula in 4 different ways in order to inspire the creation of the logical algorithm. From my point of view, there are two variables: Li and ti. Note that T (which in fact represents the entire measurement period) is the sum of every ti. Obviously the number of Li and ti values must be equal.

Link to the excel sheet

xls.jpg
 
You can use Cells property with one argument that can return row-ordered one dimensional array of cells and pick values of two ranges with the same index. Without error trapping (range sizes have to be equal, but not necessarily shapes):
Code:
Function loggadd(ti As Range, Li As Range) As Double
'Logarithmic addition
Dim T As Double, temp As Double
T = Application.WorksheetFunction.Sum(ti)
For i = 1 To ti.Cells.Count
    temp = temp + (ti.Cells(i) / T) * 10 ^ (Li.Cells(i) / 10)
Next i
loggadd = 10 * Log(temp)
End Function


combo
 
Thank you very much combo!! That's fantastic! My star goes to you.

I have made some small additions to the code to avoid the selection of ranges that have different sizes. The code seems to be working, although it's been hard to believe it a couple of hours ago. Anyway, i'm not that sure if the part with the error reporting is appropriate implemented.

Code:
Function loggadd(ti As Range, Li As Range) As Double
'Logarithmic addition

    Dim T As Double, temp As Double
    T = Application.WorksheetFunction.Sum(ti)

    If ti.Cells.Count <> Li.Cells.Count Then
        MsgBox "Input data ERROR: The size of the range 'ti' differes from 'Li' !"
        loggadd = CVErr(xlErrNA)
        
    Else
        For i = 1 To ti.Cells.Count
        temp = temp + (ti.Cells(i) / T) * 10 ^ (Li.Cells(i) / 10)
        Next i
        loggadd = 10 * Log(temp) / Log(10)
    End If
  
End Function

I was looking for tutorials on how to add description (tool tip) to my VBA function, but the information online is contradictory. Basically i would like to add a small popup/tool tip with descriptive text that gives clues about the parameters used. This pop-up should appear after you finish writing your function, i.e. [tt]=loggadd([/tt]
I attach a small screenshot with the built-in POWER function that has got this functionality.
I'm grateful for any type of help.

description.jpg


I have also noticed that the function is working even when you delete (let's say by mistake) a value of a cell inside the data range used. I attach an image to illustrate it better. What i would like to do is to provide an error reporting mechanism that warns me whenever the number of 'ti' elements is different from 'Li' and abort calculation. Easy to say, but i have no idea how to implement it. I'll be more than happy for any feedback i get from you.

Link to the xlsm file

xls2.jpg
 
Thanks for the star.

I'd avoid messages in UDF's after development time and rather use function output for messaging.

Empty cell is assumed to be 0. To test range for non-numeric or empty cells you can:
Code:
Dim test As Boolean, c As Range
test = True
For Each c In r
    If Not (IsNumeric(c) And Not IsEmpty(c)) Then test = False
Next c
MsgBox test

It is possible to customise the function appearance. You can:
- run Application.MacroOptions with proper arguments,
- from the excel interface display 'macros' dialog, write function's name, next after 'options...' you can add description (SHIFT+ENTER break lines),
- right-click function name in object browser and add description (one line).

Function description is available if started from function wizard (fx).

combo
 

Great combo, now i start to see some light in the end of the tunnel. I managed to add a description to my function, but i'm having troubles understanding what exactly you mean in the statement about messages.

The description is available indeed just if one uses function wizard.
Is there any way to get the name of the arguments popping up automatically whenever you directly type the function in a cell in Excell? See the picture with the built-in power function uploaded in my previous post - there you can easily spot the number/name of the arguments.

Below you may see the latest version of the code. I have the feeling that the red text is wrong located, but i can't figure out a better place. Everyone is welcome with ideas on how to improve/optimize it. It is also very likely to have some errors in the messaging part.

Code:
Function loggadd(ti As Range, Li As Range) As Double
'Logarithmic addition

On Error GoTo Errhandler

    Dim T As Double, temp As Double
    T = Application.WorksheetFunction.Sum(ti)
    
    Dim arg1 As Integer
    Dim arg2 As Integer
    arg1 = WorksheetFunction.CountIf(ti, "")
    arg2 = WorksheetFunction.CountIf(Li, "")
      
    If (ti.Cells.Count <> Li.Cells.Count) Or (arg1 <> arg2) Then
    [COLOR=red]loggadd = CVErr(xlErrValue) '???? this line seems to have no effect. The cell hosting the
                                'function displays 0 (i.e. zero) instead of #VALUE! whenever an error occurs[/color]
    GoTo Errhandler
        
    Else
        For i = 1 To ti.Cells.Count
        temp = temp + (ti.Cells(i) / T) * 10 ^ (Li.Cells(i) / 10)
        Next i
        loggadd = 10 * Log(temp) / Log(10)
    End If
    
    If arg1 = arg2 And arg1 > 0 And arg2 > 0 Then
    MsgBox "Calculation went alright! No reason to worry :-)" & vbCrLf & "However an equal number of blank cells are found in both 'ti' and 'Li'"
    End If
    
Exit Function


Errhandler:
    Select Case Err
        
        Case 13:     ' Error 13: mismatch
            MsgBox "Error # " & Err & " : " & Error(Err) & vbCrLf & "Some cells contain other type then numerical data"
            
        Case Else:   ' Any other errors
            MsgBox "Error # " & Err & " : " & Error(Err) & vbCrLf & "the number of selected arguments is not equal"
            
    End Select

End Function

[COLOR=red]Sub DescribeFunction() ' Should it stay in the ThisWorkBook module or in the standard code module??
                       ' What is best location?

   Dim FuncName As String
   Dim FuncDesc As String
   Dim Category As String
   Dim ArgDesc(1 To 2) As String

   FuncName = "loggadd"
   FuncDesc = "logarithmic addition bla bla..."
   Category = 7
   ArgDesc(1) = "'ti' represents bla bla bla..."
   ArgDesc(2) = "'Li' bla bla bla ..."

   Application.MacroOptions Macro:=FuncName, Description:=FuncDesc, Category:=Category, ArgumentDescriptions:=ArgDesc
   
End Sub[/color]


 
Laurent Longre describes a way to add descriptions to arguments here: The customisation code should run when the workbook is opened, it's worth to consider for an add-in.

Why not add break-point to the function and test what arg1 and arg2 are?

After the 'on error..,' the code should automatically jump to the label in case of error (such a 0/0 execution or wrong argument). If you jump to Errhandler with Goto, the Err.Number=0. Why do you need error procedure other than overflow at all? The logic is simple:
- ranges match, both are filled with numbers - calculate,
- any of above fails - output value error.

Personally I think that you expect too much from the function. Detailed error reporting with Msgbox is usually done when packing problem into vba application. Messages in UDF are annoying, typical behaviour is output value error.


combo
 

Application.MacroOptions with ArgumentDescriptions worked as you advertised earlier. This method applied to Excel 2010 does exactly what Laurent's add-in does. Fortunately i'm an excel 2010 user :) The problem was that I mis-thought i had to rerun the containing subroutine every time the function was launched or the add-in was added to a different computer. Today i moved the .xlam file to another computer and was stunned to see that it retained the descriptions, category, etc. So basically you have to run the subroutine only once, then save the add-in file, and that's all. I was too blind to see it.

I simplified the code and got rid of the error handler (ie. 'On Error GoTo Errhandler'). I also removed any error/notification messages; they were looking like a great enhancement in the beginning, but you are right, i really got fed up after a couple of testing days.
The logic is simple indeed, i can clearly see it, but it's damn hard to see how to implement it. It would be nice to have some proper variables definition and error handling, but my brain refuses to find the way.

The code seems to be error free the way it is written now. Nothing is calculated if the number of cells with numerical data in 'ti' range is different from those in 'Li'. For each 'ti' there must be an 'Li' and vice-versa.

Code:
Function loggadd(ti As Range, Li As Range) As Double
'Logarithmic addition

    Dim T As Double, temp As Double
    T = Application.WorksheetFunction.Sum(ti)
    
    Dim blankarg1 As Integer
    Dim blankarg2 As Integer
    blankarg1 = WorksheetFunction.CountIf(ti, "")
    blankarg2 = WorksheetFunction.CountIf(Li, "")
      
    If (ti.Cells.Count <> Li.Cells.Count) Or (blankarg1 <> blankarg2) Then
    loggadd = CVErr(xlErrValue)
    
    Else
        For i = 1 To ti.Cells.Count
        temp = temp + (ti.Cells(i) / T) * 10 ^ (Li.Cells(i) / 10)
        Next i
        loggadd = 10 * Log(temp) / Log(10)
    End If
    
End Function

Here comes the code i droped in ThisWorkBook; i ran it once by pressing the 'Run Sub' button, and then saved the file. I don't know if it was the proper way, but it worked for me.

Code:
Sub DescribeFunction() ' 

   Dim FuncName As String
   Dim FuncDesc As String
   Dim Category As String
   Dim ArgDesc(1 To 2) As String

   FuncName = "loggadd"
   FuncDesc = "logarithmic addition bla bla..."
   Category = "carpe diem"
   ArgDesc(1) = "'ti' represents hhhhhhhhhhhhhhhhhn hhhhhhhhhhhhhhhhhhhhhhhhh..."
   ArgDesc(2) = "'Li' bla bla bla ..."

   Application.MacroOptions Macro:=FuncName, Description:=FuncDesc, Category:=Category, ArgumentDescriptions:=ArgDesc
   
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top