Run Excel Trim Function from Access

[NauticalGent]

I tried to find this on AWF but was unable to find it, apologies if I am covering ground already covered. I learned yesterday that Trim in Excel works differently in Excel than Access:

Trim in Excel removes all spaces but one from a given string: Trim("1234 567 89") returns "1234 567 89"
Trim in Access would only remove leading and trialing spaces: Trim("1234 567 89") has no change.

So I wondered if I could tell Access to use the Excel version of Trim and after some research, here is what I came up with:

Sub RunExcelFunctionFromAccess()
    Dim excelApp As Object
    Dim varResult As Variant

    ' Create a new instance of Excel Application
    Set excelApp = CreateObject("Excel.Application")

    ' Run Excel function (e.g., TRIM)
    varResult = excelApp.WorksheetFunction.Trim("1234 567    89")

    Debug.Print "Result: " & varResult

    ' Clean up
    excelApp.Quit
    Set excelApp = Nothing
End Sub

Anyway, I thought it was a good tool to have in the toolbox.

 

[ebs17]

Public Function InnerTrim(ByVal ThisString As String) As String
    Dim sResult As String
    sResult = ThisString
    Do While InStr(1, sResult, "  ") > 0
        sResult = Replace(sResult, "  ", " ")
    Loop
    InnerTrim = sResult
End Function

You could also use regular expressions:

RegExReplace(ThisString, " {2,}", " ")

Your function with instantiation of the (very large) Excel object will be very slow. Particularly slow due to the late binding in the first call.

 

[Minty]

Interesting idea.
I would wonder if that is rather less efficient than running a function that achieves the same directly in Access?
e.g. (Aircode untested) EDIT: ebs Beat me to it.

Function fncRemoveDblSpace(str As Variant) As String

    If str & "" = "" Then
        fncRemoveDblSpace = ""
        Exit Function
    End If
   
    str = Trim(str)
Repeat:
    str = Replace(str, "  ", " ")
    If InStr(1, str, "  ", vbDatabaseCompare) > 0 Then GoTo Repeat
   
    fncRemoveDblSpace = str
   
End Function

 

[MajP]

@NauticalGent,
I think in this case it would be easier to roll your own, but the point is taken. There are plenty of Excel functions that would be extremely complicated to near impossible to roll your own. So the concept of using Worksheetfunction is very powerful.

 

[Minty]

@NauticalGent I'm with @MajP on this - I didn't mean to sound picky, there are a number of Excel functions that would take a month of Sundays to replicate in Access, and the method employed would give quick and easy access to them.

 

[MajP]

here are a number of Excel functions that would take a month of Sundays to replicate in Access, and the method employed would give quick and easy access to them.

Here is a good example
Excel has a XIRR function which is the internal rate of return. I have no idea what that means, I am not in finance. Here is the definition.

internal rate of return (IRR) is the interest rate at which the net present value of all the cash flows (both positive and negative) from a project or investment equal zero.

Internal rate of return is used to evaluate the attractiveness of a project or investment. If the IRR of a new project exceeds a company’s required rate of return, that project is desirable. If IRR falls below the required rate of return, the project should be rejected.

HOW IT WORKS (EXAMPLE):

The formula for IRR is:
0 = P0 + P1/(1+IRR) + P2/(1+IRR)2 + P3/(1+IRR)3 + . . . +Pn/(1+IRR)n
where P0, P1, . . . Pn equals the cash flows in periods 1, 2, . . . n, respectively; and
IRR equals the project's internal rate of return.

Let's look at an example to illustrate how to use IRR.
Assume Company XYZ must decide whether to purchase a piece of factory equipment for $300,000. The equipment would only last three years, but it is expected to generate $150,000 of additional annual profit during those years. Company XYZ also thinks it can sell the equipment for scrap afterward for about $10,000. Using IRR, Company XYZ can determine whether the equipment purchase is a better use of its cash than its other investment options, which should return about 10%.

Here is how the IRR equation looks in this scenario:
0 = -$300,000 + ($150,000)/(1+.2431) + ($150,000)/(1+.2431)2 + ($150,000)/(1+.2431)3 + $10,000/(1+.2431)4
The investment's IRR is 24.31%, which is the rate that makes the present value of the investment's cash flows equal to zero. From a purely financial standpoint, Company XYZ should purchase the equipment since this generates a 24.31% return for the Company --much higher than the 10% return available from other investments.
A general rule of thumb is that the IRR value cannot be derived analytically. Instead, IRR must be found by using mathematical trial-and-error to derive the appropriate rate. However, most business calculators and spreadsheet programs will automatically perform this function.
[Click here to see How to Calculate IRR Using a Financial Calculator or Microsoft Excel]
IRR can also be used to calculate expected returns on stocks or investments, including the yield to maturity on bonds. IRR calculates the yield on an investment and is thus different than net present value (NPV) value of an investment.

Someone asked how to get this from data in table inside of access. So the trick was to convert data in a table or query into a format to pass to the worksheet function. You need to read the recordset and pass in an array of payments and array of dates.

Public Function XIRR_Wrapper(Payments() As Currency, Dates() As Date, Optional GuessRate As Double = 0.9)
   'Must add a reference to the Xcel library. Use Tools, References, Microsoft Excel XX.X Object Library
   XIRR_Wrapper = Excel.WorksheetFunction.XIRR(Payments, Dates, GuessRate)
End Function

So it was not hard to write a procedure that you can pass a query which would read the recordset and create the arrays passing to the function.

Public Function AccessXIRR(Domain As String, PaymentField As String, DateField As String, PK_Field As String, PK_Value As Variant, Optional PK_IsText As Boolean = False, Optional GuessRate As Double = 0.1) As Variant
 
  'Assumes you have a table or query with a field for the Payee, the Payment, and the date paid.
  Dim Payments() As Currency
  Dim Dates() As Date
  Dim rs As dao.Recordset
  Dim strSql As String
  Dim I As Integer
 
  If PK_IsText Then PK_Value = "'" & PK_Value & "'"
  strSql = "SELECT " & PaymentField & ", " & DateField & " FROM " & Domain & " WHERE " & PK_Field & " = " & PK_Value & " ORDER BY " & DateField
  'Debug.Print strSql
  Set rs = CurrentDb.OpenRecordset(strSql)
  'Fill Payments and dates.
  ReDim Payments(rs.RecordCount - 1)
  ReDim Dates(rs.RecordCount - 1)
  Do While Not rs.EOF
    Payments(I) = rs.Fields(PaymentField).Value
      Dates(I) = rs.Fields(DateField).Value
    Debug.Print I
    I = I + 1
    rs.MoveNext
  Loop
  For I = 0 To rs.RecordCount - 1
    Debug.Print Payments(I) & " " & Dates(I)
  Next I
  AccessXIRR = XIRR_Wrapper(Payments, Dates, GuessRate)
End Function

However this worked sometimes, but for some unknown reasons it would fail in Excel. So I was asked could I write my own. I did but I had to research this and it was technically complicated. Had to figure out in vba how to take the derivative of net present value.
So that

Excel.WorksheetFunction.XIRR(Payments, Dates, GuessRate.

Required this

ublic Function MyXIRR(Payments() As Currency, Dates() As Date, Optional GuessRate As Double = 0.1) As Variant
   On Error GoTo errLbl
   Const Tolerance = 0.0001
   'Like the Excel it only searches 100 times. Not sure why 100, but you could change this
   'Based on a faulty guess you can get into a loop where you cannot converge
   Const MaxIterations = 1000
   Dim NPV As Double
   Dim DerivativeOfNPV As Double
   Dim ResultRate As Double
   Dim NewRate As Double
   Dim i As Integer
   'Since we are trying to find the Rate that makes the NPV = 0 we are finding the roots of the equation
   'Since there is no closed form to do this, you can use Newtons method
   'x_(n+1) = x_n - f(x_n)/f'(x_n)
   'Basically you evaluate the function and take the tangent at that point.  Your next x is where the tangent crosses
   'The X axis.  Each time this gets you closer and closer to the real root. Can be shown graphically
   ResultRate = GuessRate
   MyXIRR = "Not Found"
   For i = 1 To MaxIterations
     NPV = NetPresentValue(Payments, Dates, ResultRate)
     DerivativeOfNPV = DerivativeOfNetPresentValue(Payments, Dates, ResultRate)
     NewRate = ResultRate - NPV / DerivativeOfNPV
     ResultRate = NewRate
     'Debug.Print "NPV " & NPV & " NPVprime " & DerivativeOfNPV & " NewRate " & NewRate
     If Abs(NPV) < Tolerance Then
       MyXIRR = NewRate
       'Debug.Print "Solution found in " & i & " iterations"
       Exit Function
     End If
   Next i
   Exit Function
errLbl:
   Debug.Print Err.Number & " " & Err.Description
End Function

Public Function NetPresentValue(Payments() As Currency, Dates() As Date, Rate As Double) As Double
  Dim TimeInvested As Double
  Dim i As Integer
  Dim InitialDate As Date
  InitialDate = Dates(0)
  For i = 0 To UBound(Payments)
    TimeInvested = (Dates(i) - Dates(0)) / 365
    NetPresentValue = NetPresentValue + Payments(i) / ((1 + Rate) ^ TimeInvested)
  Next i
End Function

Public Function DerivativeOfNetPresentValue(Payments() As Currency, Dates() As Date, Rate As Double) As Double
  Dim TimeInvested As Double
  Dim i As Integer
  Dim InitialDate As Date
  Dim NPVprime As Double
  InitialDate = Dates(0)
  'NPV = P/(1+R)^N
  'where P is the payment, R is rate, N is the time invested
  'The derivative with respect to R is
  'DerivateNPV = -NP/(1+R)^(N+1)
  'And the derivative of a sum is the sum of the derivatives
  For i = 0 To UBound(Payments)
    TimeInvested = (Dates(i) - Dates(0)) / 365
    NPVprime = NPVprime - TimeInvested * Payments(i) / ((1 + Rate) ^ (TimeInvested + 1))
  Next i
  DerivativeOfNetPresentValue = NPVprime
End Function

So there is a plethora of very complicated functions in exce you can "wrap" in Access, that are hard or almost impossible to code yourself.

 

[NauticalGent]

@NauticalGent I'm with @MajP on this - I didn't mean to sound picky, there are a number of Excel functions that would take a month of Sundays to replicate in Access, and the method employed would give quick and easy access to them.

Agreed. In this particular case, the "Roll-Your-Own" is definitly the better way to go. For the record, I ran both codes given and of course they work MUCH faster.

I just got all excited about running Excel Functions from Access and thought I would show off a little!

 

[Uncle Gizmo]

I just got all excited about running Excel Functions from Access and thought I would show off a little!

It's an excellent example of how to Leverage Excel in MS Access. I've been playing too I've knocked up a sample database see attached!

 

[NauticalGent]

One day I'll be as smart as you guys....

Who am I kidding, no hell I won't, but as long as I have you all to hold me up, I'm ok with that!

 

[ebs17]

    Dim excelApp As Object
    ' Create a new instance of Excel Application
    Set excelApp = CreateObject("Excel.Application")

    ' do anything


    ' Clean up
    excelApp.Quit
    Set excelApp = Nothing

The real problem here is that an Excel instance is created and destroyed with every function call. That takes up time.

If you want to make repeated function calls, it would be better to create a persistent instance of Excel once and then use it:

Function RunExcelFunctionFromAccess(MyXL_Instance As Object, otherArguments) As Variant

    RunExcelFunctionFromAccess = MyXL_Instance.Worksheetfunction...

 

[The_Doc_Man]

After ebs17's comment and all the others, I'll add my two cents.

Creating a persistent Excel app object in order to get to those juicy little Excel functions isn't such a bad approach.

From a memory viewpoint, that instance of EXCEL.EXE has its own memory, so the only memory cost in the Access app is the space taken up by the direct and implied structures of an application object. If the DB that exercises this hypothetical usage is split, the app object will be in the FE and should not impose hardships on the BE file at all. Usually, the FE is smaller than the BE anyway, so there would be adequate room.

It does not appear that you need to actually create a worksheet, so there should be no file locking issues and no issues in creating vestigial or temporary files, because Excel doesn't create a lock file like Access does. Excel uses whole-file locking, or at least it behaves as if it does that, so there is also no disk space issue.

From a code viewpoint, the initial creation and destruction of the app object will each take a moment. However, if I understand the data flow correctly, in between those two actions, the Excel app is dormant unless/until you give it something to do. Otherwise it is in a "voluntary I/O wait" state and doing nothing, which means no CPU load.

Having said that, couldn't you just establish a (code page>>Tools>> References) link to the Excel library or libraries and activate your function directly - without using the object? I have Ac2021 installed. I have Excel 16.0 Library checked. When I go to Object Explorer, it shows me that the Workspaces object is defined with a gazillion functions. I cropped the image because the list went on for a long time, but it appears that all of the required functions are there if you could just properly qualify them.

 

[The_Doc_Man]

Follow-up: Use an object and set it to a "New WorksheetFunction" perhaps? Then you wouldn't have to create a whole app object, just create a data element of the appropriate type.

When I used the Excel text-to-speech recently, I created an arbitrary object variable and then assigned it to contain the object returned from a voice-related call. Worked like a champ.

"Object" as a datatype is a sort of like a variant in that it can become any kind of object you want, but Intellisense might not fully recognize it. Or you could DIM it as a WorksheetFunction object initially, in which case I would bet that all of the possible functions become exposed through Intellisense. Haven't got time at the moment to test this, but it might work.

 

[Edgar_]

@The_Doc_Man
The worksheet function would still have a Parent member, which is Excel, the application, so it would still initialize it anyway, if I'm not mistaken.

@NauticalGent
By the way, if you don't care about being specific and you're in the middle of some other code, you could also do a one liner like:
Debug.Print CreateObject("Excel.Application").WorksheetFunction.Trim("1234 567 89")

The Excel app must start anyway, so, why not?

 

[The_Doc_Man]

For the voice function in an Access database that uses the Excel library routine "Speak" - I just tested it. Excel does not pop up on Task Manager even though I turn on the voice function. You would have to test the specific case but I didn't see Excel come into existence during my test of another Excel library function.

@Edgar_ - I would test afterwards to verify that the Excel object you created didn't leave behind a running but now "dangling" copy of Excel.

 

[jdraw]

Doc,

Off topic, but I found this years ago and it still works.

Sub testspeak()
Dim s As Object
Set s = CreateObject("SAPI.SpVoice")
s.Speak "Greetings. How are you?  Is  jeopardy  over?"
Set s = Nothing
End Sub

 

[MajP]

Doc,

Off topic, but I found this years ago and it still works.

Sub testspeak()
Dim s As Object
Set s = CreateObject("SAPI.SpVoice")
s.Speak "Greetings. How are you?  Is  jeopardy  over?"
Set s = Nothing
End Sub

I can see me having a lot of fun with that in sample databases!

 

[The_Doc_Man]

So does this (where Vox is DIM'd as an object) and VoiceOn is a toggle variable driven by an on/off radio button.

Private Sub VoxTalk(Msg As String, Optional Gender As String = "Male")

    If VoiceOn Then                 'are we suppose to be chatty?
        Set Vox.Voice = Vox.GetVoices("Gender = " & Gender).Item(0)
        Vox.Speak Msg               'seems like we are... say something
    End If

End Sub

 

[The_Doc_Man]

I can see me having a lot of fun with that in sample databases!

In samples, yes. However, when I had the option in a production database, the users came after me with pitchforks and torches. Said it VERY QUICKLY got irritating.

 

[Edgar_]

For the voice function in an Access database that uses the Excel library routine "Speak" - I just tested it. Excel does not pop up on Task Manager even though I turn on the voice function. You would have to test the specific case but I didn't see Excel come into existence during my test of another Excel library function.

@Edgar_ - I would test afterwards to verify that the Excel object you created didn't leave behind a running but now "dangling" copy of Excel.

Can't say it will always close the Excel instance, but the tests I've done close it after it's done with it. I tested the Speech.Speak function and it also creates an instance of Excel because, uh, I instance it like this Excel.Application.Speech.Speak "Hello" or CreateObject("Excel.Application").Speech.Speak "Hello"

 

[sxschech]

Couple more variations on the trim and remove spaces functions using Access vba.


Examples:
? removespaces("1234 567 89") 123456789 ? removeextraspaces("1234 567 89") 1234 567 89 ? trimall(" 1234 567 89 ") 1234 567 89 ? removeextraspaces(trimall(" 1234 567 89 ")) 1234 567 89

Public Function RemoveSpaces(strInput As String)
' Removes all spaces from a string of text
Test:
   If InStr(strInput, " ") = 0 Then
      RemoveSpaces = strInput
   Else
      strInput = Left(strInput, InStr(strInput, " ") - 1) _
      & Right(strInput, Len(strInput) - InStr(strInput, " "))
      GoTo Test
   End If
End Function

Function RemoveEXTRASpaces(SpaceyWord As String) As String
'http://www.vbforums.com/showthread.php?609658-REmoving-multiple-spaces-from-a-string
'Remove extra spaces
'20151112
    Do While InStr(1, SpaceyWord, "  ")
        SpaceyWord = Replace(SpaceyWord, "  ", " ")
    Loop   
  
    RemoveEXTRASpaces = SpaceyWord
End Function

Public Function TrimAll(text As String) As String
'https://stackoverflow.com/questions/25184019/trim-all-types-of-whitespace-including-tabs
'20190122
Const toRemove As String = " " & vbTab & vbCr & vbLf 'what to remove


Dim s As Long: s = 1
Dim e As Long: e = Len(text)
Dim c As String


If e = 0 Then Exit Function 'zero len string


Do 'how many chars to skip on the left side
    c = Mid(text, s, 1)
    If c = "" Or InStr(1, toRemove, c) = 0 Then Exit Do
    s = s + 1
Loop
Do 'how many chars to skip on the right side
    c = Mid(text, e, 1)
    If e = 1 Or InStr(1, toRemove, c) = 0 Then Exit Do
    e = e - 1
Loop
TrimAll = Mid(text, s, (e - s) + 1) 'return remaining text


End Function