xlns

I got a question about math functions in excel from a guy

He needed to parse a function like (3^[x1])+([x2]^2)+[x1]+[x3]+3*[x4] into a function
And needed to parse the values for the variables via a range.

I thought I would spread the wealth and share my code with the world….

voila..

 'Set reference to: Microsoft Scripting Runtime

Public Function EVAL(sFormula As String, rVarValues As Range)

    Dim tmpDict As Dictionary
    Dim Cell As Range
    Dim i As Long

    Set tmpDict = VariableDictionary(sFormula, "[", "]")

    i = 0

    For Each Cell In rVarValues

        sFormula = Replace(sFormula, tmpDict.Items(i), Cell.Value): i = i + 1

    Next tmpCell

    Set tmpDict = Nothing

    EVAL = EVALUATE(sFormula)

End Function

Private Function VariableDictionary(sString, sStart, sEnd) As Dictionary

    Dim tmpDict As Dictionary
    Dim strTemp As String
    Dim i As Long

    strTemp = ""

    Set tmpDict = New Dictionary

    On Error Resume Next

    For i = 1 To Len(sString)

        If Mid(sString, i, 1) = sStart Then strTemp = ""

        strTemp = strTemp & Mid(sString, i, 1)

        If Mid(sString, i, 1) = sEnd Then tmpDict.Add strTemp, strTemp

    Next i

    On Error GoTo 0

    Set VariableDictionary = tmpDict

    Set tmpDict = Nothing

End Function

I came upon the this great article DAX Table Queries in Excel from Gobán Saor.
This got me thinking about automating this via VBA.
The first try immediatly led to this macro

Sub Create_QT_Test()

    Dim qtTable As QueryTable
    Dim sConn As String
    Dim sMDX As String
    Dim ws As Worksheet

    sConn = "OLEDB;Provider=MSOLAP.5;" & _
            "Persist Security Info=True;" & _
            "Initial Catalog=Microsoft_SQLServer_AnalysisServices;" & _
            "Data Source=$Embedded$;" & _
            "MDX Compatibility=1;" & _
            "Safety Options=2;" & _
            "MDX Missing Member Mode=Error;" & _
            "Optimize Response=3;" & _
            "Cell Error Mode=TextValue"

    sMDX = "DRILLTHROUGH SELECT FROM [Model] WHERE ([Measures].[Sum of trades])"

    Set ws = ActiveSheet

    Set qtTable = ws.ListObjects.Add(3, sConn, Destination:=Range("B2")).QueryTable

    With qtTable

        .CommandText = sMDX
        .CommandType = xlCmdDefault
        .Refresh

    End With

End Sub

I’m going to work on this futher and post better and more code…

regards

Jelle-jeroen

For everybody who is interested a link

We know the compression technology Excel uses to create and save the files is not optimum.
So after reading a post on BaconBits about it, I thought I would write a macro who creates (small) copies of selected excel files.
The files I produced were all around 25% smaller than the originals.
Worth the effort I would say….

Bare in mind if you save the created files they will grow again….

you can download a sample workbook here Shrink Excel Files

Sub ShrinkExcelFiles()

    Dim Fname
    Dim i As Long
    Dim sFileFolder As String

    Fname = Application.GetOpenFilename(filefilter:="Excel (*.xls*), *.xls*", _
            MultiSelect:=True, Title:="Select the Excel files you want to shrink")  

    If IsArray(Fname) = False Then
    Else

       For i = LBound(Fname) To UBound(Fname)

           sUnzipFolder = Left(Fname(i), InStrRev(Fname(i), "\")) & "unzip\"
           ShrinkXlsX Fname(i), sUnzipFolder

       Next i

    End If

End Sub

Sub ShrinkXlsX(sFileName, sTempFolder)

    Dim objApp As Object
    Dim vFileName As Variant
    Dim sFileExtension As String
    Dim i As Long

    sFileExtension = Right(sFileName, Len(sFileName) - InStrRev(sFileName, "."))

    Name sFileName As sFileName & ".zip"

    CreateFolder sTempFolder

    Set oApp = CreateObject("Shell.Application")

    For Each ItemInZip In oApp.Namespace(sFileName & ".zip").items

        oApp.Namespace(sTempFolder).CopyHere (ItemInZip)

    Next

    Open sFileName & "_Small.zip" For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1

    i = 1

    For Each ItemInFolder In oApp.Namespace(sTempFolder).items

        oApp.Namespace(sFileName & "_Small.zip").CopyHere (ItemInFolder)

        Do Until oApp.Namespace(sFileName & "_Small.zip").items.Count = i

            Application.Wait (Now + TimeValue("0:00:01"))

        Loop

        i = i + 1

    Next

    Name sFileName & "_Small.zip" As sFileName & "_Small." & sFileExtension
    Name sFileName & ".zip" As sFileName

    DeleteFolder sTempFolder

End Sub

Sub DeleteFolder(MyPath)

    Dim FSO As Object

    Set FSO = CreateObject("scripting.filesystemobject")

    If Right(MyPath, 1) = "\" Then MyPath = Left(MyPath, Len(MyPath) - 1)

    If FSO.FolderExists(MyPath) = False Then Exit Sub

    FSO.DeleteFolder MyPath

End Sub

Sub CreateFolder(MyPath)

    Dim FSO As Object

    Set FSO = CreateObject("scripting.filesystemobject")

    If Right(MyPath, 1) = "\" Then MyPath = Left(MyPath, Len(MyPath) - 1)

    If FSO.FolderExists(MyPath) = True Then DeleteFolder MyPath

    FSO.CreateFolder MyPath

End Sub

Sometimes you need the average and standard deviation of a dataset without a certain amount of outliers.

For example you want the average or standard deviation without the top 2.5% datapoints

{=AVERAGE(IF((DataRng<LARGE(DataRng,ROUNDUP((COUNT(DataRng)*0.025),0))),DataRng))}

{=STDEV.P(IF((DataRng<LARGE(DataRng,ROUNDUP((COUNT(DataRng)*0.025),0))),DataRng))}

If you want the average without the top 10 and bottom 10 datapoints this would be your solution

{=AVERAGE(IF((DataRng<LARGE(DataRng,10))*(DataRng>SMALL(DataRng,10)),DataRng))}

happy averaging or standard deviating

I’m back from my holiday in the land of no internet and cellphone coverage.
The up side was ( or one of the up sides ) I had time finally post this piece of code to unprotect a sheet with a forgotten password.
The nice thing is you can protect the sheet with the found password and the old password still works …. lol

Sub PasswordBreaker()

   Dim i0 As Integer, i1 As Integer, i2 As Integer, i3 As Integer
   Dim i4 As Integer, i5 As Integer, i6 As Integer, i7 As Integer
   Dim i8 As Integer, i9 As Integer, m1 As Integer, m2 As Integer

   Dim sPassword As String

   On Error Resume Next

   For i0 = 65 To 66: For i1 = 65 To 66: For i2 = 65 To 66: For i3 = 65 To 66
   For i4 = 65 To 66: For i5 = 65 To 66: For i6 = 65 To 66: For i7 = 65 To 66
   For i8 = 65 To 66: For i9 = 65 To 66: For m1 = 65 To 66: For m2 = 32 To 126

   sPassword = ""
   sPassword = sPassword & Chr(i0) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5)
   sPassword = sPassword & Chr(i6) & Chr(i7) & Chr(i8) & Chr(i9) & Chr(m1) & Chr(m2)

   ActiveSheet.Unprotect sPassword

   Application.StatusBar = False

   If ActiveSheet.ProtectContents = False Then

      MsgBox "Password used to unprotect this sheet is: " & sPassword

      Exit Sub

   End If

   Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next

End Sub

regards

L.S.

Found a great short Demo for SQL Server Project Crescent on Youtube.

enjoy

L.S.

Found this great pdf with Excel 2010 Ctrl combination shortcut keys.

enjoy

L.S.

I recently came upon some vba code in a workbook from the Hong Kong branch.
There were a lot of construction in there like:

Range(ThisWorkbook.Names("RANGE_NAME").RefersTo).ListObject.QueryTable.Refresh

Range(ThisWorkbook.Names("RANGE_NAME").RefersTo).Cells(1, 1).Value

Does anybody know why someone would code like this….?

regards..

L.S.

I got a link from a tweet from @marcorus for downloading Denali CTP3 but it didn’t work.
Figured out what the URL’s should be….

64 bit files

Core.box
Install.exe
Lang.box

32 bit files

Core.box
Install.exe
Lang.box

enjoy ( for now …. ? )