Posts on Sulprobil

sbGetCell (VBA)

Mon, 25 May 2026 10:39:00 +0100

Abstract

In older versions of Excel you could retrieve interesting information about worksheet cells by using the Excel4 macro function GET.CELL. Define the name HasFormula with the value

=GET.CELL(48,INDIRECT("RC[-1]",FALSE))

for example. If you then had inserted =HasFormula next right to a cell, you would have been shown whether the cell had a formula (“True”) or not (“False”).

If you want to achieve similar results with VBA use the UDF sbGetCell below.

Test Date Formulas (Excel)

Mon, 25 May 2026 10:31:00 +0100

Abstract

How can I ensure that an Excel date formula is correct?

I need to test it!

This works best:

I generate all days of the relevant date range in column A. 1-Jan-1901 to 31-Dec-2099, for example.
I enter all possible formulas in columns B, C, D, … and copy down.
I compare all results to the reference formula in column B.

Example

How many ISO calendar weeks does a given month touch?

sbEAN (VBA)

Mon, 25 May 2026 10:28:00 +0100

Abstract

If you need to calculate or to check an international article number (also known as European article number or EAN):

Appendix sbEAN Code

Please read my Disclaimer.

Option Explicit

Function sbEAN(s As String, _
  Optional bFullEAN As Boolean = True, _
  Optional bEAN14 As Boolean = False) As Variant
'Calculate or check EAN check digit. Works for EAN-8,
'EAN-13, EAN-14 / GTIN, and for EAN-18 / NVE / SSCC.
'If EAN is given without check digit, it is calculated
'and returned (full EAN if bFullEAn is True or just the
'check digit if False). If full EAN is entered the
'result of the check (True or False) will be returned.
'Source (EN): https://www.sulprobil.de/sbean_en/
'Source (DE): https://www.berndplumhoff.de/sbean_de/
'(C) (P) by Bernd Plumhoff 31-Mar-2024 PB V0.3
Dim i As Long, d As Long, m As Long, w As Long
Dim bCheck As Boolean
m = Len(s)
For i = 1 To m
  w = Asc(Mid(s, i, 1))
  If w < 48 Or w > 57 Then
    sbEAN = CVErr(xlErrNum)
    Exit Function
  End If
Next i
If bEAN14 Then
  If m = 13 Then
    bCheck = False
  ElseIf m = 14 Then
    bCheck = True
    m = m - 1 'Calculate checksum without check digit
  Else
    sbEAN = CVErr(xlErrValue)
    Exit Function
  End If
Else
  Select Case m
  Case 7, 12, 17
    bCheck = False
  Case 8, 13, 18
    bCheck = True
    m = m - 1 'Calculate checksum without check digit
  Case Else
    sbEAN = CVErr(xlErrValue)
    Exit Function
  End Select
End If
w = 3
For i = m To 1 Step -1
    d = d + Mid(s, i, 1) * w
    w = 4 - w 'Alternate between 3 and 1
Next i
d = (10 - d Mod 10) Mod 10
If bCheck Then
  sbEAN = Right(s, 1) = d
ElseIf bFullEAN Then
  sbEAN = s & d
Else
  sbEAN = d
End If
End Function

Download

Please read my Disclaimer.

sbSpellNumber (VBA)

Mon, 25 May 2026 06:43:00 +0100

“Number rules the universe.” [Pythagoras]

Abstract

Sometimes you need to spell numbers in English words with Dollars/Cents or British Pound Sterling/Pence or European Euro/Cent. 12.31 would result in Twelve Dollars and Thirtyone Cents, for example.

Note: There are many faulty spellnumber versions circulating in the web. I suggest to test your preferred version with the inputs listed below:

Appendix – sbSpellNumber / sbInWorten Code

Please read my Disclaimer.

Private sNWord(0 To 28) As String
Private sHWord(1 To 4) As String

Function sbInWorten(ByVal sNumber As String) As String
   sbInWorten = sbSpellNumber(sNumber, "German", "EUR")
End Function

Function sbSpellNumber(ByVal sNumber As String, _
           Optional sLang As String = "English", _
           Optional sCcy As String = "USD") As String
'Template was Microsoft's limited version:
'https://support.microsoft.com/de-de/help/213360/
'how-to-convert-a-numeric-value-into-english-words-in-excel
'This version informs the user about its limits.
'Source (EN): https://www.sulprobil.de/sbspellnumber_en/
'Source (DE): https://www.berndplumhoff.de/sbinworten_de/
'(C) (P) by Bernd Plumhoff  02-Mar-2018 PB V1.0

Dim Euros As String, cents As String
Dim Result As String, Temp As String
Dim DecimalPlace As Integer, Count As Integer
Dim Place(1 To 6) As String
Dim dNumber As Double
Dim prefix As String, suffix As String

Select Case sLang
Case "English"
   Place(1) = ""
   Place(2) = " Thousand "
   Place(3) = " Million "
   Place(4) = " Billion "
   Place(5) = " Trillion "
   Place(6) = " Mantissa not wide enough for this number "
   sHWord(1) = ">>>>> Error (Absolute amount > 999999999999999)! <<<<<"
   sHWord(2) = " (rounded)"
   sHWord(3) = "Minus "
   sHWord(4) = "and"
   sNWord(0) = "zero"
   sNWord(1) = "one"
   sNWord(2) = "two"
   sNWord(3) = "three"
   sNWord(4) = "four"
   sNWord(5) = "five"
   sNWord(6) = "six"
   sNWord(7) = "seven"
   sNWord(8) = "eight"
   sNWord(9) = "nine"
   sNWord(10) = "ten"
   sNWord(11) = "eleven"
   sNWord(12) = "twelve"
   sNWord(13) = "thirteen"
   sNWord(14) = "fourteen"
   sNWord(15) = "fifteen"
   sNWord(16) = "sixteen"
   sNWord(17) = "seventeen"
   sNWord(18) = "eighteen"
   sNWord(19) = "nineteen"
   sNWord(20) = "twenty"
   sNWord(21) = "thirty"
   sNWord(22) = "fourty"
   sNWord(23) = "fifty"
   sNWord(24) = "sixty"
   sNWord(25) = "seventy"
   sNWord(26) = "eighty"
   sNWord(27) = "ninety"
   sNWord(28) = "hundred"
Case "German"
   Place(1) = ""
   Place(2) = " Tausend "
   Place(3) = " Millionen "
   Place(4) = " Milliarden "
   Place(5) = " Billionen "
   Place(6) = " Die Mantisse ist nicht groß genug für diese Zahl "
   sHWord(1) = ">>>>> Fehler (Absolutbetrag > 999999999999999)! <<<<<"
   sHWord(2) = " (gerundet)"
   sHWord(3) = "Minus "
   sHWord(4) = "und"
   sNWord(0) = "null"
   sNWord(1) = "ein"
   sNWord(2) = "zwei"
   sNWord(3) = "drei"
   sNWord(4) = "vier"
   sNWord(5) = "fünf"
   sNWord(6) = "sechs"
   sNWord(7) = "sieben"
   sNWord(8) = "acht"
   sNWord(9) = "neun"
   sNWord(10) = "zehn"
   sNWord(11) = "elf"
   sNWord(12) = "zwölf"
   sNWord(13) = "dreizehn"
   sNWord(14) = "vierzehn"
   sNWord(15) = "fünfzehn"
   sNWord(16) = "sechzehn"
   sNWord(17) = "siebzehn"
   sNWord(18) = "achtzehn"
   sNWord(19) = "neunzehn"
   sNWord(20) = "zwanzig"
   sNWord(21) = "dreißig"
   sNWord(22) = "vierzig"
   sNWord(23) = "fünfzig"
   sNWord(24) = "sechzig"
   sNWord(25) = "siebzig"
   sNWord(26) = "achtzig"
   sNWord(27) = "neunzig"
   sNWord(28) = "hundert"
End Select

'Empty string = 0
If "" = sNumber Then
   sNumber = "0"
End If
      
dNumber = sNumber + 0#
      
'If we cannot cope with it, tell the user!
If Abs(dNumber) > 999999999999999# Then
   sbSpellNumber = sHWord(1)
   Exit Function
End If

'If we have to round we present a suffix "(rounded)"
If Abs(dNumber - Round(dNumber, 2)) > 1E-16 Then
   dNumber = Round(dNumber, 2)
   suffix = sHWord(2)
End If

'Negative numbers get a prefix "Minus"
If dNumber < 0# Then
   prefix = sHWord(3)
   dNumber = -dNumber
   sNumber = Right(sNumber, Len(sNumber) - 1)
End If

sNumber = Trim(Str(sNumber))
If Left(sNumber, 1) = "." Then
   sNumber = "0" & sNumber
End If

DecimalPlace = InStr(sNumber, ".")
        
If DecimalPlace > 0 Then
   cents = GetTens(Left(Mid(sNumber, DecimalPlace + 1) & "00", 2), _
               sLang, sCcy)
   sNumber = Trim(Left(sNumber, DecimalPlace - 1))
End If

Count = 1
Do While sNumber <> ""
   Temp = GetHundreds(Right(sNumber, 3), sLang, sCcy)
   If Temp <> "" Then
       If Euros <> "" And sLang = "German" Then
           Euros = Temp & Place(Count) & " " & _
                   sHWord(4) & " " & Euros
       Else
           Euros = Temp & Place(Count) & Euros
       End If
   End If
   If Len(sNumber) > 3 Then
       sNumber = Left(sNumber, Len(sNumber) - 3)
   Else
       sNumber = ""
   End If
   Count = Count + 1
Loop
  
Select Case sCcy
Case "EUR"
   Select Case Euros
       Case ""
           Euros = sNWord(0) & " Euros"
       Case sNWord(1)
           Euros = sNWord(1) & " Euro"
       Case Else
           Euros = Euros & " Euros"
   End Select
  
   Select Case cents
       Case ""
           cents = " " & sHWord(4) & " " & sNWord(0) & " Cents"
       Case sNWord(1)
           cents = " " & sHWord(4) & " " & sNWord(1) & " Cent"
       Case Else
           cents = " " & sHWord(4) & " " & cents & " Cents"
   End Select
Case "GBP"
   Select Case Euros
       Case ""
           Euros = sNWord(0) & " Pounds"
       Case sNWord(1)
           Euros = sNWord(1) & " Pound"
       Case Else
           Euros = Euros & " Pounds"
   End Select
  
   Select Case cents
       Case ""
           cents = " " & sHWord(4) & " " & sNWord(0) & " Pence"
       Case sNWord(1)
           cents = " " & sHWord(4) & " " & sNWord(1) & " Penny"
       Case Else
           cents = " " & sHWord(4) & " " & cents & " Pence"
   End Select
Case "USD"
   Select Case Euros
       Case ""
           Euros = sNWord(0) & " Dollars"
       Case sNWord(1)
           Euros = sNWord(1) & " Dollar"
       Case Else
           Euros = Euros & " Dollars"
   End Select
  
   Select Case cents
       Case ""
           cents = " " & sHWord(4) & " " & sNWord(0) & " Cents"
       Case sNWord(1)
           cents = " " & sHWord(4) & " " & sNWord(1) & " Cent"
       Case Else
           cents = " " & sHWord(4) & " " & cents & " Cents"
   End Select
End Select

Temp = UCase(Replace(Euros & cents, "  ", " "))
Select Case sLang
Case "English"
   Temp = Application.WorksheetFunction.Proper(Temp)
   Temp = Replace(Temp, " And ", " and ")
Case "German"
   Temp = Application.WorksheetFunction.Proper(Temp)
   Temp = Replace(Temp, "Ein Millionen", "Eine Million")
   Temp = Replace(Temp, "Ein Milliarden", "Eine Milliarde")
   Temp = Replace(Temp, "Ein Billionen", "Eine Billion")
   Temp = Replace(Temp, "Dollars", "Dollar")
   Temp = Replace(Temp, "Cents", "Cent")
   Temp = Replace(Temp, "Pounds", "Pfund")
   Temp = Replace(Temp, "Pound", "Pfund")
   Temp = Replace(Temp, "Euros", "Euro")
   Temp = Replace(Temp, "Pence", "Pennies")
   Temp = Replace(Temp, " Und ", " und ")
End Select
    
sbSpellNumber = prefix & Temp & suffix

End Function

Private Function GetHundreds(ByVal sNumber, _
           Optional sLang As String = "English", _
           Optional sCcy As String = "USD") As String
Dim Result As String

If Val(sNumber) = 0 Then Exit Function
   sNumber = Right("000" & sNumber, 3)

   If Mid(sNumber, 1, 1) <> "0" Then
       Result = GetDigit(Mid(sNumber, 1, 1)) _
               & sNWord(28)
       If Mid(sNumber, 2, 2) <> "00" Then
           Result = Result & sHWord(4)
       End If
   End If

   If Mid(sNumber, 2, 1) <> "0" Then
       Result = Result & GetTens(Mid(sNumber, 2), sLang, sCcy)
   ElseIf Mid(sNumber, 3, 1) <> "0" Then
       Result = Result & GetDigit(Mid(sNumber, 3))
   End If

   GetHundreds = Result
End Function

Private Function GetTens(TensText As String, _
           Optional sLang As String = "English", _
           Optional sCcy As String = "USD")
Dim Result As String

Result = ""
If Val(Left(TensText, 1)) = 1 Then   '10-19...
   If Val(TensText) > 9 And Val(TensText) < 20 Then
       GetTens = sNWord(Val(TensText))
   End If
   Exit Function
Else                               '20-99...
   If Val(Left(TensText, 1)) > 1 And _
       Val(Left(TensText, 1)) < 10 Then
       Result = sNWord(18 + Val(Left(TensText, 1)))
   Else
       Result = GetDigit(Right(TensText, 1))
   End If
   If Right(TensText, 1) <> "0" And Left(TensText, 1) <> "0" Then
       Select Case sLang
       Case "German"
           Result = GetDigit(Right(TensText, 1)) & _
                       sHWord(4) & Result
       Case "English"
           Result = Result & GetDigit(Right(TensText, 1))
       End Select
   End If
End If
GetTens = Result
End Function

Private Function GetDigit(Digit As String) As String
If Val(Digit) < 10 Then
   GetDigit = sNWord(Val(Digit))
Else
   GetDigit = ""
End If
End Function

Download

Please read my Disclaimer.

Optimal Usage of Vacation Days (VBA)

Mon, 25 May 2026 06:42:00 +0100

“I need a vacation.” [Arnold Schwarzenegger as T-800 in Terminator 2]

Abstract

Each year we members of the working population are asking ourselves when we should take our vacation.

This program shows you the maximal achievable number of free days for your given vacation days:

Example: With the given bank holidays in 2024 and just 7 days of vacation you can get 16 free days from 14-Dec-2024 until 29-Dec-2024. You cannot achieve more in 2024, as the second best solution proves (that will result in 14 free days only).

sbTasklist (VBA)

Mon, 25 May 2026 03:25:00 +0100

“Patience has its limits. Take it too far, and it is cowardice.” [George Jackson]

Abstract

If your team runs many different manual tasks, not all of them on each working day but only on specified weekdays or days of a month, then this tasklist creator might be of help to you.

In sheet Param enter your team name or other reference which will be put into the footer of each page, and enter ther valuation day:

RoundToSum (VBA)

Mon, 25 May 2026 03:14:00 +0100

“Every fool can know. The point is to understand.” [Albert Einstein]

Rounding Values Preserving Their Sum

Rounded values do not always sum up to their original total, as demonstrated in this article. How can you ensure that the sum of rounded percentages equals exactly 100%? Is it possible to guarantee that, for accounting purposes, the distribution of overhead costs precisely matches the original total? These challenges are well-known and have been studied extensively.

sbZip (VBA)

Sun, 24 May 2026 08:04:00 +0100

Abstract

You can easily create a zip file via VBA.

This is the variant I like to use:

Appendix – sbZip Code

Please read my Disclaimer.

Option Explicit

#Const SBZIP_LOG = True 'Use sbZip with logging (True) or not (False)

Sub sbZip(ByVal vSourceFullPathName As Variant, _
          ByVal vDestinationZipFullPathName As Variant, _
          Optional bCreate As Boolean = True, _
          Optional bUse7zip As Boolean = False)
'Create zip file vDestinationZipFullPathName and insert zipped file or folder vSourceFullPathName.
'This sub is using LibFileTools, https://github.com/cristianbuse/VBA-FileTools.
'If bUse7zip:=True then 7zip needs to be installed at C:\Program Files\7-Zip\7z.exe.
'Version When        Who   What
'     14 08-May-2025 Bernd Overwrite zip constituent (by moving it to Temp)
'                          without warning message that it already exists
'     15 25-Dec-2025 Bernd Use #If SBZIP_LOG
Dim iFile     As Integer
Dim lItems    As Long
Dim lRepeat   As Long
Dim sBasename As String
Dim sLine     As String
Dim sShellCmd As String
Dim sPath     As String
Dim v         As Variant
Dim oExec     As Object
Dim oOutput   As Object
Dim oShell    As Object
#If SBZIP_LOG Then
Dim GLogger   As clsLog
#End If
#If MEASURE_RUNTIME Then
Dim cPerf     As clsPerf 'See: https://jkp-ads.com/Articles/performanceclass.asp

Set cPerf = New clsPerf
cPerf.SetRoutine "sbZip"
#End If
#If SBZIP_LOG Then
Set GLogger = New clsLog
g_log_params.log_sub_name = "sbZip"
GLogger.info "Started with vSourceFullPathName = '" & vSourceFullPathName & _
          "', vDestinationZipFullPathName = '" & vDestinationZipFullPathName & _
          "', bCreate = " & bCreate & _
          "', bUse7zip = " & bUse7zip
#End If
If bCreate Then
  If IsFile(CStr(vDestinationZipFullPathName)) Then
    If Not DeleteFile(CStr(vDestinationZipFullPathName)) Then
#If SBZIP_LOG Then
      GLogger.warn "Could not delete file '" & vDestinationZipFullPathName & "'"
#End If
    End If
  End If
End If
If bUse7zip Then
  If IsFile("C:\Program Files\7-Zip\7z.exe") Then
    Set oShell = CreateObject("WScript.Shell")
    sShellCmd = "C:\Program Files\7-Zip\7z.exe a """ & vDestinationZipFullPathName & _
      """ """ & vSourceFullPathName & """"
    Set oExec = oShell.exec(sShellCmd)
    Set oOutput = oExec.StdOut
    Do While Not oOutput.AtEndOfStream
      sLine = oOutput.ReadLine
#If SBZIP_LOG Then
      If sLine <> "" Then GLogger.info "STDOUT " & sLine
#End If
    Loop
    Set oOutput = oExec.StdErr
    Do While Not oOutput.AtEndOfStream
      sLine = oOutput.ReadLine
#If SBZIP_LOG Then
      If sLine <> "" Then GLogger.warn "STDERR " & sLine
#End If
    Loop
    Do While oExec.Status = 0
      Application.Wait (Now + TimeValue("0:00:01"))
    Loop
#If SBZIP_LOG Then
    GLogger.info vSourceFullPathName & "' zipped into '" & vDestinationZipFullPathName & "'"
#End If
  Else
#If SBZIP_LOG Then
    GLogger.fatal "C:\Program Files\7-Zip\7z.exe doesn't exist. Cannot zip '" & _
    vSourceFullPathName & "'"
#End If
  End If
Else
  If bCreate Then
    sPath = GetLocalPath(ThisWorkbook.Path)
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    If IsFile(sPath & "Zip_Template.zip") Then
      'Workaround in case print sequence in Else clause does not work
      CopyFile sPath & "Zip_Template.zip", CStr(vDestinationZipFullPathName)
      If Not IsFile(CStr(vDestinationZipFullPathName)) Then
#If SBZIP_LOG Then
        GLogger.warn "Could not copy template file '" & vDestinationZipFullPathName & "'"
#End If
      End If
    Else
      iFile = FreeFile
      Open vDestinationZipFullPathName For Output As #iFile
      Print #iFile, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
      Close #iFile
    End If
  End If
 
  Set oShell = CreateObject("Shell.Application")
  On Error Resume Next
  lItems = oShell.Namespace(vDestinationZipFullPathName).Items.Count
  On Error GoTo 0
  If GetAttr(vSourceFullPathName) = vbDirectory Then
    oShell.Namespace(vDestinationZipFullPathName).CopyHere _
    oShell.Namespace(vSourceFullPathName).Items, 16
    lRepeat = 0
    On Error Resume Next
    Do Until oShell.Namespace(vDestinationZipFullPathName).Items.Count = _
      lItems + oShell.Namespace(vSourceFullPathName).Items.Count Or lRepeat > 5
      Application.Wait (Now + TimeValue("0:00:01"))
      lRepeat = lRepeat + 1
    Loop
    On Error GoTo 0
  Else
    If lItems > 0 Then
      sBasename = Right(vSourceFullPathName, InStr(StrReverse(vSourceFullPathName), "\") - 1)
      For Each v In oShell.Namespace(vDestinationZipFullPathName).Items
        If v.Name = sBasename Then
          oShell.Namespace(Environ("Temp")).MoveHere (v)
          DeleteFile Environ("Temp") & "\" & sBasename
          Exit For
        End If
      Next v
    End If
    oShell.Namespace(vDestinationZipFullPathName).CopyHere vSourceFullPathName, 16
    lRepeat = 0
    On Error Resume Next
    Do Until oShell.Namespace(vDestinationZipFullPathName).Items.Count = _
      lItems + 1 Or lRepeat > 3
      Application.Wait (Now + TimeValue("0:00:01"))
      lRepeat = lRepeat + 1
    Loop
    On Error GoTo 0
  End If
End If
#If SBZIP_LOG Then
GLogger.info "Beendet ohne Fehler"
#End If
End Sub

Download

Please read my Disclaimer.

Krabat (Excel)

Sun, 24 May 2026 04:06:00 +0100

Abstract

(External link!) Krabat is a fantasy novel written by Otfried Preußler.

I found the story fascinating, albeit quite illogical: 12 apprentices work at the mill. Each year one dies, each year a new one appears with a start age of 14, each year all of them age by 3 years.

After 30 years there can be an apprentice who is 101 years old:

Download

Please read my Disclaimer.

Krabat_The_Satanic_Mill.xlsx [15 KB Excel file, open and use at your own risk]

sbNRN (VBA)

Sun, 24 May 2026 03:26:00 +0100

“God made the integers, all the rest is the work of man.” [Leopold Kronecker]

Abstract

Which rational number is a good proxy of π (3.1415926…)? Enter in cell A1 ‘=pi()’, in cell B1 your maximal denominator (for example 10), and in cells C1:D1 ‘=sbNRN(A1,B1)' as array formula (with CTRL + SHIFT + ENTER). You will get in C1:D1 22 and 7. That means: 22/7 is the nearest rational number to π with a denominator not higher than 10. For 1000 in B1 you would get 355/113.

Excel VBA A Collection (Excel / VBA)

Sat, 23 May 2026 07:12:00 +0100

“Spreadsheets are probably among the most dangerous inventions of recent decades.” [Rolf Dobelli]

Excel VBA A Collection

This is a collection of Excel VBA programs and of some Excel spreadsheet formulas which I found reasonable.

Note: I successfully tested the applications and formulas presented here with Excel 2024.

Table of Contents                                                               
                                                                                
Excel / VBA – A Collection                                                      1
  Abstract                                                                      2
  Excel Learning Path                                                           2
The Excel / VBA Programming Environment                                        11
  Abstract                                                                     11
  Basics                                                                       11
    Variables                                                                  11
      Types of Variable                                                        11
      Scope                                                                    12
    During Editing                                                             12
    During Program Execution                                                   13
      Breakpoints                                                              13
      Error Handling                                                           13
    Environment Variables                                                      15
    Good Programming Practices                                                 15
      Be a Good Programmer                                                     15
      Good Excel and VBA Knowledge                                             15
      Programming Conventions                                                  16
      Clean Up Macro Recordings                                                16
      Document Your Program Adequately                                         16
      Test Your Program Thoroughly                                             16
      Log Your Program Execution                                               16
  Speed up Your Program (Profiling)                                            17
    Modules                                                                    17
      Normal                                                                   17
    Class Modules                                                              19
  System Status Save and Restore – SystemState Class                           20
    System Status Variables                                                    20
    SystemState Program Code                                                   21
  Documenting Program Flow – Logging Class                                     23
    Pros and Cons                                                              23
    Parameters                                                                 24
    Sample Output                                                              25
    Modules                                                                    26
    Class Modules                                                              31
  Start / Stop OneDrive Synchronization                                        33
  Export a Range as Picture – sbExportRange2Picture                            35
  List Named Ranges – sbNamedRanges                                            38
  Number of Dimensions of an Array – ArrayDim                                  38
  Show Excel Version – ApplicationVersion                                      39
  Retrieve Cell Information – sbGetCell                                        40
  Next Floating Point Number – sbNextFloat                                     46
  Calling Other Windows Programs Using the Example sbZip                       47
  Excel Don’t’s – What You Should not be Doing with Excel                      49
    A table of what you should avoid                                           49
Number Systems, Formats, and Transformations                                   50
  Abstract                                                                     50
  Transformations and Calculations of Numbers                                  50
    Spell Numbers in English Words – sbSpellNumber                             50
    Convert Decimal into Binary Numbers – sbDec2Bin / sbBin2Dec                54
    Identify German Bank Holidays – IstFeiertag                                59
    Present the Full-Length Number – sbNum2Str                                 63
    Significant Digits of a Number – sbNSig                                    64
    Return the Number for a Month’s Name – sbMonthNumber                       65
    Calculation of the Circle Constant π                                       68
      First 1,000 Digits of π                                                  71
    Calculation of Euler's Number e                                            72
      First 1,000 Digits of e                                                  73
    Literature                                                                 74
    Shorten a Number Sequence Representation – sbParseNumSeq                   74
  Rational Numbers = Fractions                                                 76
    Nearest Rational Number to a Given Floating Point Number – sbNRN           76
    Linear Equations with Rational Coeffizients                                79
    Present Quota Changes as Fractions                                         82
    Monthly Fractions                                                          83
  Linear Combination of Integers                                               84
    Extended Euklidean Algorithm – sbEuklid                                    84
  Time Representations                                                         86
    Calculate Working Hours Between Two Time Points – sbTimeDiff               86
    Add Working Hours to a Time Point – sbTimeAdd                              89
    Convert a Time to a Different Time Zone – ConvertTime                      92
  Check Digits                                                                 92
    Calculate or Check a European Article Number – sbEAN                       92
  Ordinal Numbers                                                              93
Simple Math with Formulas                                                      94
  How to Analyze Spreadsheet Formulas                                          94
  Testing Date Formulas                                                        95
  First or last Weekday of a Month                                             97
  Same Weekday and Calendarweek last year                                      98
  Budget Control                                                               99
  Increment Lowest Significant Digit                                          100
  Linear Breakdown                                                            101
  Merge two columns justified into one                                        104
  Minimum Truck Load Problem                                                  105
  Count Trailing Zeros                                                        106
  Minimax Interpolation                                                       106
  Interpolation with PERCENTILE / PERCENTRANK                                 108
  Interpolation with TREND                                                    110
  REFA Time Slicing                                                           111
  Roles and Rights                                                            112
  Rounding is Fun                                                             113
  Tip Distribution                                                            114
  Smoothing Inner Period Values                                               116
  Cell Based Charts                                                           117
Simple VBA Programs                                                           119
  Abstract                                                                    119
  Sum up Numbers with same Number Format – sbSumMyFormat                      119
  Count Cells with Certain Color – sbCountMyColor                             120
  Allocate Assets to a Portfolio – sbAllocate                                 121
  Eliminate Outliers – sbORB                                                  122
  Fair Distribution of a Limited Budget – sbDistBudget                        124
  Compute Collatz Length – sbCollatz                                          126
  Rank Item Uniquely – sbUniqRank                                             127
  Eliminate Points of a Graph with Small Slope Changes – sbReducePoints       129
  Birthday List – sbBirthdayList                                              131
  Accumulated Trade Blotter – sbAccumulatedTadeBlotter                        133
  Most Frequent Pairs – sbMostFrequentPairs                                   135
  Interpolate – sbInterp                                                      137
  Combinations with Subsets k of n                                            139
  Lookup Variants                                                             141
  Minimal Number of Banknotes and Coins – sbMinCash                           144
  Rebalance AssetClass Weights of a Portfolio – sbRebalancedReturn            147
  Optimal Pitstops                                                            149
  Optimal Usage of Vacation Days                                              151
  Create a Round Robin Tournament – sbRondRobin                               153
  Test Access Rights                                                          156
Advanced VBA Programs                                                         159
  Abstract                                                                    159
  Employee Revenue Shares                                                     159
  Keeping Track of extreme Cell Values – sbCellWatermarks                     165
  A Task List – sbTaskList                                                    167
  Accounts Receivable Problem                                                 170
  Data Analysis – sbDatastats                                                 173
    System Handbook                                                           173
      Overview                                                                173
      Parameters in Sheet Param                                               174
    User Handbook                                                             174
      Summary                                                                 174
      Config File FileSpecs.csv                                               175
      Numstats Output                                                         175
      Numstats Move Output                                                    176
      Textstats Output                                                        176
      Textstats Move Output                                                   176
      Output Limits File                                                      177
      Output Limits Move File                                                 178
  Lottery k-Tuples                                                            208
  Mini Calculator                                                             211
  Mortality Annuities                                                         218
    Complex Array Formula (Worst)                                             218
    Simple user defined function in VBA (Better)                              219
    Pre-calculated Table plus an NPV Formula (Maybe Best)                     219
  Financial Mathematics – Options                                             220
    The binomial Method                                                       220
    Trinomial Trees and Finite Difference Methods                             226
    Monte Carlo Simulation                                                    232
  Generate all Permutations of an Array – Quickperm                           242
  A maintenance-free Database                                                 244
    Limitations                                                               244
    Responsibilities                                                          244
    System Documentation                                                      245
    User Documentation                                                        245
      Super User with Read/Write Access                                       245
      Normal User with Read-Only Access                                       245
    Appendix – SQL Code                                                       246
    Appendix – VBA Code                                                       249
Rounding Values Preserving Their Sum with RoundToSum                          252
  Abstract                                                                    252
  Rounding Values Preserving Their Sum                                        252
    Percentage Example                                                        252
    Example with Absolute Values                                              253
  The User-Defined VBA Function RoundToSum                                    253
  RoundToSum Program Code                                                     254
  Round2Sum Lambda Expression                                                 255
  Rounding Values Alters Their Sum                                            256
  How many numbers do you need to round into the wrong direction?             258
  Usage Examples of RoundToSum                                                260
    Allocation of Overheads                                                   260
    Example of an Exact Relation of Random Numbers                            262
      The User-Defined VBA Function sbExactRandHistogrm                       263
    Fair Staff Selection Based on Team Size – sbFairStaffSelection            265
    Distribute a Sample Normally                                              267
    Distribution of Budgets Among Remaining Staff                             272
      A Simple Approach                                                       272
      A Correct Calculation                                                   272
    Take Vacation When Less is Going on                                       273
      Simple Example                                                          273
      More Complex Example                                                    274
    Assign Work Units Adjusted by Delivered Output                            275
  RoundToSum Versus Other Methods                                             276
    RoundToSum Versus Other "Simple" Methods                                  276
    RoundToSum Compared to the D’Hondt Approach                               279
  Literature                                                                  279
Random Number Generation (Excel / VBA)                                        280
  Abstract                                                                    280
  Random Integers                                                             280
    Natural Random Numbers – UniqRandInt                                      280
    Random Integers – sbRandInt                                               282
    Random Numbers with a Specified Sum                                       284
      Minimum of Random Numbers given – sbLongRandSumN                        284
      Minimum and Maximum of Random Numbers given – sbRandIntFixSum           285
  Usage Examples for Random Integers                                          287
    Krabat, the Satanic Mill – How old can the apprentices become?            287
    Generate a Math Test with Random Integer Inputs – Generate_Math_Test      288
    Monte Carlo Simulation to Generate Teams Fairly – sbGenerateTeams         290
    Monte Carlo Simulation for a Regatta Flight Plan – sbRegattaFlightPlan    294
    Chances at Board Game Risk                                                297
    A Simple Monte Carlo Simulation                                           301
  Random Floating Point Numbers                                               303
    Generate an Ideal Normal Distribution – sbGenNormDist                     303
    Generate Random Numbers with a Sum of 1 – sbRandSum1                      305
    Distributions of Random Floating Point Numbers                            307
      sbRandGeneral                                                           307
      sbRandHistogrm                                                          310
      sbRandTriang                                                            313
      sbRandTrigen                                                            314
      sbRandCauchy                                                            318
      sbRandCDFInv                                                            319
      sbRandPDF                                                               320
      sbRandCumulative                                                        321
    Brownian Bridges                                                          323
      sbGrowthSeries                                                          323
      Fix Sum from Random Corridors                                           325
  Correlated Random Numbers                                                   327
    Cholesky Decomposition                                                    327
    Iman-Conover Method                                                       329
  Practical Applications of General Random Numbers                            336
    Generating Test Data – sbGenerateTestData                                 336
    Random Numbers which do not reappear too soon – sbRandomNoRepeatBeforeN   346
  Excursus                                                                    348
    Calculating Probabilities – Drawing Cards With and Without Replacement    348
Fun without Practical Relevance for Advanced Learners                         349
  A Simple VBA Pivot Table – sbMiniPivot                                      349
  Round-Robin Tournament Pairings with Excel Worksheet Functions              352
    Developing a Formula-Based Solution for a Round-Robin Tournament          352
  TEXTJOIN                                                                    356
Index                                                                         357

Please read my Disclaimer.

sbCollatz (VBA)

Sat, 23 May 2026 06:57:00 +0100

“Mathematics is not yet ready for such problems.” [Paul Erdös]

Abstract

The Collatz conjecture states for positive integers:

If the number is even, halve it
If the number is odd, triple it and add one

If you apply above rules repetitively, you will always reach 1.

Example

If you start with 5, you will get 5, 16, 8, 4, 2, 1 which results in the Collatz length of 6.

Appendix – sbCollatz Code

Please read my Disclaimer.

sbDec2Bin (VBA)

Sat, 23 May 2026 06:56:00 +0100

Abstract

What is the binary representation (bitlength = 256) of the decimal number -872362346234627834628734627834627834628? Don’t ask Excel’s built-in function DEC2BIN. It can only deal with numbers between -512 and 511. If you want to get the correct answer

1111111111111111111111111111111111111111111111111111111111111111111111111111
1111111111111111111111111111111111111111111111111101011011111011010100011111
1001110111100101111001000010000111010110010010100110011010001001100111101010
0001010101001011110011111100

then have a look at the function sbDec2Bin listed below.

Please note that fractional parts are supported for positive decimals only. The decimal 0.5 is in binary format equal to 0.1, for example.

Extended Euklidean Algorithm (VBA)

Sat, 23 May 2026 06:55:00 +0100

Abstract

You need to represent a number as a non-negative linear combination of two positive integers?

You can achieve this with the (external link!) extended Euklidean Algorithm:

Note: If your desired result is a multiple of the greatest common divisor of the inputs then there will always be an integer solution, but not necessarily a non-negative one. Example: You can represent 1 with the inputs 5 and 3 because 1 is the GCD of 3 and 5: 1 = 2 * 5 + (-3) * 3. But you cannot achieve this with non-negative integers only.

sbMinCash (VBA)

Fri, 22 May 2026 05:49:00 +0100

Abstract

You need to find the right banknotes and coins to make up a given cash amount?

The function below might return with an error value, though:

xlErrNum - The input amount or a face value of a banknote or a coin has more than 2 decimal places
xlErrValue - A face value of a banknote or a coin is negative or not valid
xlErrNull - No banknotes nor coins given
xlErrNA - There is no solution

Known limitation: In some less fortunate cases such as banknotes with face values 1, 6, and 10 the cash amount 13 will come out as 10, 1, 1, 1, and not as 6, 6, 1. Good message: This will not happen for normal cases of face values 1000, 500, 200, 100, 50, 20, 10, 5, 2, 1, 0.50, 0.20, 0.10, 0.05, 0.02, and 0.01.

Accounts Receivable Problem (VBA)

Fri, 22 May 2026 05:48:00 +0100

“It’s not that I’m so smart, it’s just that I stay with problems longer.” [Albert Einstein]

Abstract

Mr Excel’s challenge of the month of August 2002 stated:

“An accounts receivable department receives a check from a customer for $4,556.92. Upon looking in the accounting system, there are 54 unpaid invoices, ranging from $77.74 to $5,465.45. The payment must be for some exact combination of entire invoices, but we don’t know which invoices are being paid.”

sbInterp (VBA)

Thu, 21 May 2026 01:52:00 +0100

“Write what you know. That should leave you with a lot of free time.” [Howard Nemerov]

Abstract

If you have a given set of known (x, y) points and you need to know y-parts of other given x parts then you need to interpolate. It is similar to filling gaps of a table:

Appendix – sbInterp Code

Please read my Disclaimer.

Option Explicit
    
Function sbInterp(vX As Variant, vY As Variant, _
           vT As Variant, _
           Optional ByVal sType As String = "Linear", _
           Optional bExtrapolate As Boolean = True, _
           Optional ByVal sExtraType As String) As Variant
'Interpolates y-values for target values vT with known
'y-values vY and known x-values vX with type sType.
'sType can be:
'Const or C
'Linear or L
'LinearInVariance or LIV
'Extrapolation will be done if bExtrapolate is TRUE.
'Extrapolation type sExtraType defaults to sType if empty.
'Values in vX must be in ascending order. #VALUE! error
'indicates illegal sType, #NUM! error indicates that
'extrapolation has been switched off and #N/A tells you
'that x-values are not given in increasing order, or
'y-value count differs from x-value count.
'Source (EN): https://www.sulprobil.de/sbinterp_en/
'Source (DE): https://www.berndplumhoff.de/sbinterp_de/
'(C) (P) by Bernd Plumhoff 25-Dec-2023 PB V0.7
Dim i As Long, iX As Long, iY As Long, iT As Long, k As Long
Dim vTk, vXi
Dim sT As String 'Type of inter- or extrapolation
Dim sEType As String 'Extrapolation type
With Application
On Error Resume Next
iX = vX.Count
iX = UBound(vX)
iY = vY.Count
iY = UBound(vY)
iT = vT.Count
iT = UBound(vT)
On Error GoTo 0
If iX <> iY Then
    sbInterp = CVErr(xlErrNA)
    Exit Function
End If
k = 0
ReDim vX1(1 To iX) As Variant, vY1(1 To iX) As Variant
For i = 1 To iX
    If vX(i) <> "" And vY(i) <> "" Then
        k = k + 1
        vX1(k) = vX(i)
        vY1(k) = vY(i)
    End If
Next i
iX = k
ReDim Preserve vX1(1 To iX) As Variant
ReDim Preserve vY1(1 To iX) As Variant
If iX < 2 Then
    sType = "Const"
    sExtraType = "Const"
Else
    For k = 2 To iX
        If vX1(k) <= vX1(k - 1) Then
            sbInterp = CVErr(xlErrNA)
            Exit Function
        End If
    Next k
End If
ReDim vR(1 To iT) As Variant
If sExtraType = "" Then
    sEType = sType 'Same as interpolation type
Else
    sEType = sExtraType
End If
For k = 1 To iT
    i = 0
    vTk = 0
    vXi = 0
    On Error Resume Next
    i = .Match(vT(k), vX1, 1)
    vTk = vT(k)
    vXi = vX1(i)
    On Error GoTo 0
    If Not bExtrapolate And _
        (i = 0 Or (i = iX And vTk <> vXi)) Then
        vR(k) = CVErr(xlErrNum)
    Else
        sT = sType 'Set to interpolation type
        If i = 0 Then
            i = 1
            sT = sEType 'Set to extrapolation type
        End If
        If i = iX Then
            i = i - 1
            If vTk <> vXi Then
                sT = sEType 'Set to extrapolation type
            End If
            If sT = "C" Or sT = "Const" Then i = i + 1
        End If
        Select Case sT
        Case "C", "Const"
            vR(k) = .Index(vY1, i)
        Case "L", "Linear"
            vR(k) = .Index(vY1, i) + (vTk - .Index(vX1, i)) _
                * (.Index(vY1, i + 1) - .Index(vY1, i)) _
                / (.Index(vX1, i + 1) - .Index(vX1, i))
        Case "LIV", "LinearInVariance"
            On Error Resume Next
            vR(k) = Sqr(.Index(vY1, i) ^ 2# + (vTk - .Index(vX1, i)) _
                * (.Index(vY1, i + 1) ^ 2# - .Index(vY1, i) ^ 2#) _
                / (.Index(vX1, i + 1) - .Index(vX1, i)))
            On Error GoTo 0
        Case Else
            sbInterp = CVErr(xlErrValue)
            Exit Function
        End Select
    End If
Next k
If TypeName(vT) = "Range" Then
    If vT.Rows.Count > vT.Columns.Count Then
        vR = .Transpose(vR)
    End If
ElseIf TypeName(.Caller) = "Range" Then
    If .Caller.Rows.Count > .Caller.Columns.Count Then
        vR = .Transpose(vR)
    End If
End If
sbInterp = vR
End With
End Function

Download

Please read my Disclaimer.

Options (VBA)

Wed, 20 May 2026 04:38:00 +0100

Abstract

A classic on implementing option models is

Les Clewlow and Chris Strickland: Implementing Derivatives Models (ISBN 0471966517)

Unfortunately this book suffers from quite a few typos, and the 8 pages list of errata from November 23, 2000 does not seem to be publicly available anymore.

Some error corrections of the first edition:

Page	Row	Correction
xvi	9, column 3	0v should be C
12	15	Si,j = Su^jd^(n-j)
24	2 from top in figure 2.12	set coefficients
70	4 from bottom in figure 3.13	for j =Nj-2 downto -Nj+1 do
70	Insert before last row of figure 3.13	C[1,-Nj] = C[1,-Nj + 1] - lambda_L
75	4 from bottom in figure 3.16	for j =Nj-2 downto -Nj+1 do
75	Insert before last row of figure 3.16	C[1,-Nj] = C[1,-Nj + 1] - lambda_L
85	2 from bottom in figure 4.2	SD = sqrt( (-sum_CT2 + sum_CT * sum_CT / M ) ) * exp(-2rT) / (M - 1)
89	2 from bottom in figure 4.5	SD = sqrt( (-sum_CT2 + sum_CT * sum_CT / M ) ) * exp(-2rT) / (M - 1)
99	Delete row 9 from top	lnS = ln(S) = 4.6052 <- delete this row
113	13 from top in figure 4.19	Insert before for j loop V1 = sig1sig1; V2 = sig2sig2
113	18 from top in figure 4.19	Insert before for i loop Vt1 = V1; Vt2 = V2
118	Last row	a = m/N * ln(Gt) …
120	11 from bottom in figure 4.24	G = productSt ^(1/N)

I started to implement some of the algorithms with Excel VBA.

Mortality Annuities (Excel, VBA)

Wed, 20 May 2026 04:37:00 +0100

Abstract

If you like to calculate annuities of a mortality table you have a bunch of choices:

Complex Array Formula (Worst)

Apply a complex one-cell array formula:

The names are defined as follows:

Simple user defined function in VBA (Better)

A better way by far is a simple VBA function:

Please read my Disclaimer.

Option Explicit
    
Function LiveAnnuityPV(lYears As Long, dInterestRate As Double, _
    rMortalityTable As Range) As Double
'Source (EN): https://www.sulprobil.de/mortality_annuities_en/
'Source (DE): https://www.berndplumhoff.de/mortality_annuities_de/
'(C) (P) by Bernd Plumhoff 22-Mar-2014 PB V0.1
Dim j As Long
Dim dSum As Double, dProd As Double, dPV As Double

dProd = 1#
dPV = 1#
For j = 1 To rMortalityTable.Count - lYears
    dPV = dPV / (1# + dInterestRate)
    dProd = dProd * (1# - rMortalityTable(j + lYears))
    dSum = dSum + dPV * dProd
Next j

LiveAnnuityPV = dSum

End Function

Pre-calculated Table plus an NPV Formula (Maybe Best)

The fastest and maybe best approach seems to be a pre-calculated table and an NPV formula:

QuickPerm (Excel / VBA)

Wed, 20 May 2026 04:36:00 +0100

Abstract

If you need to generate all permutations of an array I suggest to use the algorithm (external link!) Quickperm. It is one of the most efficient permutation algorithms. It is based on swaps of single array elements and inspired by Heap sort.

The version presented here is the CountDown variant. For the Excel / VBA implementation all indices were increased by one so that arrays start with index 1.

Example

Input:

Combinations with Subsets k of n (Excel / VBA)

Wed, 20 May 2026 04:35:00 +0100

Abstract

This algorithm generates all subsets of n with k elements.

The Excel function COMBIN(n, k) shows the count of all combinations, but the algorithm presented here lists all combinations individually so that you can examine them if necessary. The program is fast - you can compare to the formula solutions you can find below under Other Links.

Example

Input:

Output:

Literature

Reingold, Nievergelt, Deo: Combinatorial Algorithms, 1977, Algorithm 5.9, p. 186, ISBN 0-13-152447-X

Fix Sum from Random Corridors (Excel)

Wed, 20 May 2026 04:34:00 +0100

Abstract

You want seven random numbers with different border values to add up to 100 exactly?

Important note: There will be no solution if the sum of the lower borders exceeds 100 or if the sum of the upper borders is less than 100. This is being checked in cells K2:K3.

The Distribution of the Random Numbers

The generated random numbers from above example are quite equally distributed.

PF_Allocate (VBA)

Wed, 20 May 2026 04:33:00 +0100

Abstract

If you need to generate random portfolios with a given total sum and lower boundaries and upper boundaries for each asset, you can take the function PF_Allocate() shown below.

Appendix – PF_Allocate Code

Please note that this program needs (calls) UniqRandInt.

Please read my Disclaimer.

Option Explicit
    
Function PF_Allocate(db As Double, _
    vlb As Variant, _
    vub As Variant) As Double()
'Generate a portfolio of assets x1..xN
'x1..xN being random numbers (double) with:
'x1+x2+..xN = db 'budget
'xi >= vlb(i)    'lower bound vector
'xi <= vub(i)    'upper bound vector
'Source (EN): https://www.sulprobil.de/pf_allocate_en/
'Source (DE): https://www.berndplumhoff.de/pf_allocate_de/
'(C) (P) by Bernd Plumhoff 26-Jul-2020 PB V0.11
Dim i As Variant, n As Long
Dim dcumx As Double
Dim dcumlb As Double
Dim dcumub As Double
Dim dxlb As Double
Dim dxub As Double

'Application.Volatile
dcumlb = Application.WorksheetFunction.Sum(vlb)
dcumub = Application.WorksheetFunction.Sum(vub)
If dcumlb > db Or dcumub < db Then
    PF_Allocate = CVErr(xlErrValue)
    Exit Function
End If
n = vlb.Count
ReDim dR(1 To n) As Double
dcumx = 0#
'For i = 1 To n 'Old biased solution
For Each i In VBUniqRandInt(n, n)
    'Source (EN): https://www.sulprobil.de/uniqrandint_en/
    If vlb(i) > vub(i) Then
        PF_Allocate = CVErr(xlErrValue)
        Exit Function
    End If
    dcumlb = dcumlb - vlb(i)
    dcumub = dcumub - vub(i)
    dxlb = db - dcumx - dcumub
    If dxlb < vlb(i) Then dxlb = vlb(i) 'dxlb = Min(..)
    dxub = db - dcumx - dcumlb
    If dxub > vub(i) Then dxub = vub(i) 'dxub = Max(..)
    dR(i) = dxlb + Rnd() * (dxub - dxlb)
    dcumx = dcumx + dR(i)
Next i
PF_Allocate = dR
End Function

Download

Please read my Disclaimer.

Linear Equations with Rational Coefficients (VBA)

Wed, 20 May 2026 04:32:00 +0100

Abstract

Linear equations of the form A * x = b with the non-singular quadratic matrix A and the result vector b have a unique solution because the determinant of A is not zero. If the coefficients of A and of b are rational numbers then the solution is also rational.

Literature

(External Link!) Oliver Aberth, A method for exact computation with rational numbers, JCAM, vol 4, no. 4, 1978

Create statistics for weighted values (VBA)

Wed, 20 May 2026 04:31:00 +0100

Statistics for Weighted Values

Here I provide statistics for weighted values:

Average
Correlation
Covariance
Kurtosis
Mode
Median
Skewness (whole statistical population)
Standard Deviation (sample and whole statistical population)
Variance

Please notice that the prerequisite here is that the weights are natural numbers, i.e. positive integers.

Example

Appendix - sbSWV Code

Please read my Disclaimer.

Option Explicit

#Const SORTED = False

Function sbSWV(sStat As String, _
        ParamArray vInput() As Variant) As Variant
'Calculate some statistical measures of weighted values
'Source (EN): https://www.sulprobil.de/sbswv_en/
'Source (DE): https://www.berndplumhoff.de/sbswv_de/
'(C) (P) by Bernd Plumhoff 20-Aug-2024 PB V0.81
Dim d As Double, d2 As Double, dSum As Double
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim vV, vV2, vV3, vW 'Variants

With Application.WorksheetFunction
vV = .Transpose(vInput(0))
Select Case sStat
Case "COVAR", "CORREL"
    vV2 = .Transpose(vInput(1))
    vW = .Transpose(vInput(2))
Case Else
    vW = .Transpose(vInput(1))
End Select
On Error GoTo errhdl
i = vV(1) 'Force error in case of vertical arrays
On Error GoTo 0
If UBound(vV) <> UBound(vW) Then
    'Arrays of values and of weights must have same dimension
    sbSWV = CVErr(xlErrNum)
    Exit Function
End If
Select Case UCase(sStat)
Case "AVERAGE"
    sbSWV = .SumProduct(vV, vW) / .Sum(vW)
Case "CORREL"
    vV3 = vV
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    d2 = .SumProduct(vV2, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV3(i) = vW(i) * (vV(i) - d) * (vV2(i) - d2)
        vV(i) = vW(i) * (vV(i) - d) ^ 2#
        vV2(i) = vW(i) * (vV2(i) - d2) ^ 2#
    Next i
    sbSWV = .Sum(vV3) / Sqr(.Sum(vV) * .Sum(vV2))
Case "COVAR"
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    d2 = .SumProduct(vV2, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV(i) = vW(i) * (vV(i) - d) * (vV2(i) - d2)
    Next i
    sbSWV = .Sum(vV) / dSum
Case "KURT"
    n = .Sum(vW)
    ReDim dV(1 To n) As Double
    k = 1
    For i = 1 To UBound(vW)
      For j = 1 To vW(i)
        dV(k) = vV(i)
        k = k + 1
      Next j
    Next i
    sbSWV = .Kurt(dV)
Case "MODE"
    k = .Max(vW)
    If k < 2 Then
        sbSWV = CVErr(xlErrNA)
        Exit Function
    End If
    sbSWV = vV(.Match(.Max(vW), vW, False))
Case "MEDIAN"
    If .Min(vW) < 1 Then
        sbSWV = CVErr(xlErrNA)
        Exit Function
    End If
    k = 0
    j = .Sum(vW)
    m = j Mod 2
    For i = LBound(vW) To UBound(vW)
        If vW(i) Mod 1 <> 0 Then
            sbSWV = CVErr(xlErrNum)
            Exit Function
        End If
        #If Not SORTED Then
            'Ensure ascending values in case input is unsorted.
            'This simple bubble sort leads to a quadratic runtime
            'but it's still quicker on 50 input values or more than
            'Lorimer Miller's nifty worksheet function approach
            '=LOOKUP(2,1/FREQUENCY(SUM(B1:B50)/2,SUMIF(A1:A50,"<="&A1:A50,B1:B50)),A1:A50)
            'BTW: Lorimer's approach is different from Excel's MEDIAN
            '(see below); and his other elegant array formula
            '=MEDIAN(IF(TRANSPOSE(ROW(A1:A1000))<=B1:B50,A1:A50))
            'calculates like Excel's MEDIAN but IMHO it's way too slow
            For n = i + 1 To UBound(vW)
                If vV(n) < vV(i) Then
                    d = vV(i)
                    vV(i) = vV(n)
                    vV(n) = d
                    d = vW(i)
                    vW(i) = vW(n)
                    vW(n) = d
                End If
            Next n
        #End If
        k = k + vW(i)
        Select Case 2 * k
        Case j + m
            If m = 0 Then
                #If Not SORTED Then
                    'Ensure vV(i + 1) is next greater value
                    For n = i + 2 To UBound(vW)
                        If vV(n) < vV(i + 1) Then
                            vV(i + 1) = vV(n)
                        End If
                    Next n
                #End If
                'Here Lorimer's function mentioned above would
                'return vV(i), the lower value
                sbSWV = (vV(i) + vV(i + 1)) / 2#
            Else
                sbSWV = vV(i)
            End If
            Exit Function
        Case Is > j + m
            sbSWV = vV(i)
            Exit Function
        End Select
    Next i
Case "SKEW.P"
    n = .Sum(vW)
    ReDim dV(1 To n) As Double
    k = 1
    For i = 1 To UBound(vW)
      For j = 1 To vW(i)
        dV(k) = vV(i)
        k = k + 1
      Next j
    Next i
    sbSWV = .Skew_p(dV)
Case "STDEV"
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV(i) = Abs(vV(i) - d) ^ 2#
    Next i
    sbSWV = Sqr(.SumProduct(vV, vW) / (dSum - 1#))
Case "STDEV.P"
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV(i) = Abs(vV(i) - d) ^ 2#
    Next i
    sbSWV = Sqr(.SumProduct(vV, vW) / dSum)
Case "VAR"
    dSum = .Sum(vW)
    d = .SumProduct(vV, vW) / dSum
    For i = LBound(vV) To UBound(vV)
        vV(i) = vW(i) * (vV(i) - d) ^ 2#
    Next i
    sbSWV = .Sum(vV) / (dSum - 1#)
Case Else
    sbSWV = CVErr(xlErrValue)
End Select
Exit Function
errhdl:
'Transpose variants to be able to address them
'with vV(i), not vV(i,1)
vV = .Transpose(vV)
vW = .Transpose(vW)
Select Case sStat
Case "COVAR", "CORREL"
    vV2 = .Transpose(vV2)
End Select
Resume Next
End With
End Function

Download

Please read my Disclaimer.

ApplicationVersion (VBA)

Wed, 20 May 2026 04:30:00 +0100

{Sturgeon’s Law} “Sure, 90% of all software is crap. That’s because 90% of everything is crap.” [Mary Shaw, Carnegie-Mellon University]

Abstract

Microsoft has decided in its eternal wisdom not to increase Application.Version beyond 16 from Excel 2016 on.

My function ApplicationVersion fixes this and returns a human readable version string.

Appendix – ApplicationVersion Code

Please read my Disclaimer.

Function ApplicationVersion(Optional bShowBuild365 As Boolean = True) As String
'Returns MS Excel's version - with a little kludge
'Source (EN): https://www.sulprobil.de/applicationversion_en/
'Source (DE): https://www.berndplumhoff.de/applicationversion_de/
'(C) (P) by Bernd Plumhoff 20-Oct-2024 PB V0.61
Dim n As Integer
With Application
n = Val(.Version)
Select Case n
Case 16
  ApplicationVersion = "Excel 2016"
  On Error Resume Next 'We know what we are doing
  'Excel 2024 (LTSC) introduced ValueToText
  n = Val(.ValueToText(19))
  If n = 19 Then
    If .Build = "17932" Then
      ApplicationVersion = "Excel 2024"
    Else
      If bShowBuild365 Then
        'When all of them are 365 you might want to know the build.
        ApplicationVersion = "Excel 365 (Build " & .Build & ")"
      Else
        ApplicationVersion = "Excel 365"
      End If
    End If
  Else
    'Excel 2021 (LTSC) introduced RandArray
    n = .RandArray(1, 1, 18, 18, True)(1)
    If n = 18 Then
      ApplicationVersion = "Excel 2021"
    Else
      'Excel 2019 introduced TextJoin
      n = Val(.TextJoin(" ", True, "17"))
      If n = 17 Then ApplicationVersion = "Excel 2019"
    End If
  End If
  On Error GoTo 0
Case 15
  ApplicationVersion = "Excel 2013"
Case 14
  ApplicationVersion = "Excel 2010"
Case 12
  ApplicationVersion = "Excel 2007"
Case 11
  ApplicationVersion = "Excel 2003"
Case 10
  ApplicationVersion = "Excel 2002"
Case 9
  ApplicationVersion = "Excel 2000"
Case 8
  ApplicationVersion = "Excel 97"
Case 7
  ApplicationVersion = "Excel 7/95"
Case 5
  ApplicationVersion = "Excel 5"
Case Else
  ApplicationVersion = "[Error]"
End Select
End With
End Function

Download

Please read my Disclaimer.

sbRebalancedReturn (VBA)

Wed, 20 May 2026 04:29:00 +0100

Abstract

Portfolio rebalancing is the process of bringing the different asset classes back into proper relationship following a significant change in one or more assets. You return your portfolio to the proper mix of stocks, bonds, cash or other assets when they no longer conform to your plan/limits.

An example:

Appendix – sbRebalancedReturn Code

Please read my Disclaimer.

Option Explicit

Const CMaxDouble = 1.79769313486231E+308
Function sbRebalancedReturn(rARM As Range, _
    rIWV As Range, _
    Optional ByVal lRF As Long = 0, _
    Optional dDT As Double = CMaxDouble) As Variant
'RebalancedReturn calculates balanced returns for a
'portfolio with given
'rARM - asset return matrix (columns show different
'       assets, rows show returns per asset over time)
'rIWV - initial weight vector for the assets
'lRF  - rebalancing frequency (in time steps = rows)
'       If lRF > 0 then each lRF time step rebalancing
'       will take place
'       If lRF = 0 then no rebalancing will take place
'       If lRF < 0 then each -lRF time step after last
'       rebalance portfolio will be rebalanced again
'dDT  - drift tolerance %, if any asset has drifted by
'       by more than dDT (relative measure) then the
'       portfolio will be rebalanced AND the internal
'       rebalancing frequency count will be reset
'The output matrix shows portfolio returns % in first
'column, then end-of-period asset weights and finally
'boolean output values in last column, showing whether
'a rebalance happened.
'This function has been inspired by Andreas Steiner's
'similar function.
'Source (EN): https://www.sulprobil.de/sbrebalancedreturn_en/
'Source (DE): https://www.berndplumhoff.de/sbrebalancedreturn_de/
'(C) (P) by Bernd Plumhoff 19-Mar-2011 PB V0.2
Dim i As Long, j As Long, k As Long, n As Long, m As Long
Dim bDrifted As Boolean, bForceRB As Boolean

n = rARM.Rows.Count 'Number of observations
m = rARM.Columns.Count 'Number of assets

If m <> rIWV.Columns.Count Or _
    rIWV.Rows.Count <> 1 Then
    sbRebalancedReturn = CVErr(xlErrValue)
    Exit Function
End If

ReDim w0(1 To m) As Double, x(1 To m) As Double
ReDim r(1 To n, 1 To m) As Double

If lRF = 0 Then lRF = n
If lRF < 0 Then
    lRF = -lRF
    bForceRB = True
Else
    bForceRB = False
End If

ReDim vR(1 To n, 1 To m + 2)
For i = 1 To m
    x(i) = rIWV(i)
    w0(i) = x(i)
    For j = 1 To n
        r(j, i) = rARM(j, i)
    Next j
Next i

k = 1
'Model rebalancing tolerance
For i = 1 To n
    If bDrifted And bForceRB Then k = i
    'Calculate period start weights
    vR(i, m + 2) = (i - k) Mod lRF = 0 Or bDrifted
    If vR(i, m + 2) Then
        For j = 1 To m
            x(j) = w0(j)
        Next j
    Else
        For j = 1 To m
            x(j) = vR(i - 1, 1 + j)
        Next j
    End If
    'Calculate portfolio return
    For j = 1 To m
        vR(i, 1) = vR(i, 1) + x(j) * r(i, j)
    Next j
    'Calculate period end weights & check for drift
    bDrifted = False
    For j = 1 To m
        vR(i, 1 + j) = x(j) * (1# + r(i, j)) / (1# + vR(i, 1))
        bDrifted = bDrifted Or Abs(vR(i, 1 + j) - w0(j)) > dDT
    Next j
Next i
sbRebalancedReturn = vR
End Function

Download

Please read my Disclaimer.

ArrayDim (VBA)

Wed, 20 May 2026 04:28:00 +0100

Abstract

How do you determine the number of dimensions of an array?

Appendix – ArrayDim Code

Please read my Disclaimer.

Option Explicit

Function ArrayDim(v As Variant) As Long
'Returns number of dimensions of an array or 0 for
'an undimensioned array or -1 if no array at all.
'Source (EN): https://www.sulprobil.de/arraydim_en/
'Source (DE): https://www.berndplumhoff.de/arraydim_de/
'(C) (P) by Bernd Plumhoff 10-May-2010 PB V0.1
Dim i As Long
ArrayDim = -1
If Not IsArray(v) Then Exit Function
On Error Resume Next
'Err.Clear 'Not necessary
Do While IsNumeric(UBound(v, i + 1))
  If Err.Number <> 0 Then Exit Do
  i = i + 1
Loop
ArrayDim = i
End Function

Sub test()
'Expected output: -1, 0, 1, 3
Dim v
Dim w()
Dim x(1 To 2)
Dim y(1, 2, 3)
Debug.Print ArrayDim(v)
Debug.Print ArrayDim(w)
Debug.Print ArrayDim(x)
Debug.Print ArrayDim(y)
End Sub

Please read my Disclaimer.

Quota Change as Fraction (Excel/VBA)

Wed, 20 May 2026 04:27:00 +0100

Abstract

Sometimes you need to present quota changes in a simple way. You can achieve this with fractions:

Example: Miller, Smith, and Schulz form a joint heirship. Smith dies without an heir. His quota will be distributed. Schulz also dies. His widows will receive 2/3 of his quota, his only child will get 1/3. Please note that you need to enter this as =1/3 * 2/3 resp. =1/3 * 1/3 whereby the first 1/3 represents Schulz’ original quota.

Distribute a Sample normally (VBA)

Wed, 20 May 2026 04:26:00 +0100

Abstract

You have 11.256 christmas trees in stock. A customer wants to purchse 1.500 of them, with one condition: the average height of the trees must be 6.50 meters.

Your goal is to keep the remaining trees as close to a normal distribution as possible.

How can you achieve this?

A Sample Calculation

Let’s assume the count and distribution of trees are as shown in the diagram above.

ManageOneDriveSync (VBA)

Sun, 17 May 2026 07:08:00 +0100

Abstract

Microsoft Microsoft OneDrive is a file hosting service provided by Microsoft. With the help of this service, files can be uploaded and also retrieved and edited from other services.

However, this service requires some time to synchronize files. The VBA subroutine Check_OneDrive_Sync checks whether a program has already been fully synchronized (i.e. is ready to run).

When creating or editing many files, it is sometimes advisable to temporarily disable OneDrive synchronization. This is made possible by the VBA subroutine ManageOnedriveSync.

Write-Log (PowerShell)

Sun, 17 May 2026 06:52:00 +0100

“Knowing is not enough; we must apply. Willing is not enough; we must do.” [Johann Wolfgang von Goethe]

Abstract

PowerShell is a Microsoft Windows based object orientated script / programming language. It has its own command line interface.

Normally I would prefer a platform independent language like Python. But within a Windows environment you can do almost anything with PowerShell. And sometimes I just do not like to perform all tasks with Excel / VBA. PowerShell can perform tasks in background mode, at a scheduled time, etc.

Allocation of Overheads (Excel / VBA)

Sat, 16 May 2026 10:44:00 +0100

Abstract

When allocating overhead costs to products you often encounter the fact that the resulting sum of allocated overheads does not equal the original cost sum. Due to rounding differences you frequently face a little cent difference. In this case the user defined function RoundToSum can help.

A real-life Example

We present an allocation of overheads where all individual cent values accurately add up to their intermediate or final sums.

First you define how the overheads have to be allocated to support cost centres:

Excel Don'ts

Sat, 16 May 2026 10:43:00 +0100

Abstract

“Always listen to experts. They’ll tell you what can’t be done and why. Then do it.” [Robert Heinlein]

Criticism should be constructive - in general I try to show how things could or should positively be done. But during more than 30 years of Excel practice I encountered some examples which could and maybe should be avoided.

A table of what you should avoid

Please look at this list as an intellectual challenge and take it with a grain of salt.

Cell Based Charts (Excel)

Sat, 16 May 2026 05:40:00 +0100

Dietmar P. came up with a nice cell based chart. I applied some changes and enhancements like introducing auto-scaling and adding two parameters:

A number format to allow for a general format change if necessary
A Boolean parameter to control whether to switch the green and red colouring of the chart. If you hire a contractor then you might like to show staying below the budget with a green colour, but if you like to present sales figures then it might be the other way round

Budget Control (Excel)

Fri, 15 May 2026 13:01:00 +0100

“If you want creativity, take a zero off your budget. If you want sustainability, take off two zeros.” [Jaime Lerner]

Abstract

This is a simple budget planning and control table.

Enter into cells B5:E5 your departments’ annual budget.

In cells G7:J18 should be the corresponding seasonal weights for each department. As an example please see festive articles (Easter and Christmas) as well as summer articles. The purchase department will have corresponding costs 2 months in advance.

Linear Breakdown (Excel)

Fri, 15 May 2026 13:00:00 +0100

“I’m not such a big fan of having a linear answer to things.” [Adam Driver]

Abstract

How can you break down annual data such as:

to monthly data which is piece-wise linear:

In cells A2:B5 you enter your annual input data. In cells A8:A56 you enter the chronological month ends. For a start you can enter into B8: =B2/12. In B9 you enter =VLOOKUP(DATE(YEAR($A9)-1,12,31),A$8:B8,2)+(MONTH($A9))*(VLOOKUP(YEAR($A9),$A$2:$B$5,2)-VLOOKUP(DATE(YEAR($A9)-1,12,31),A$8:B8,2)*12)/(12*(12+1)/2) and copy down. In D8 enter =STDEV(B9:B56) In case you need EXACT numbers rounded to the cent, preserving the original sum, enter into C9 =ROUND(B9,2) and into D10 =ROUND(SUM(B$9:B10),2)-SUM(C$9:C9) and copy down. This is just a pragmatic rounding method without VBA. If you like to perform this correctly, look up RoundToSum.

sbRandGeneral (VBA)

Thu, 14 May 2026 16:01:00 +0100

“It pays to be obvious, especially if you have a reputation for subtlety.” [Isaac Asimov]

Abstract

If you want to create a step-wise linear random number distribution - and you can approximate any distribution with a given accuracy with such one - then you can use my user defined function sbRandGeneral.

Documentation

The documentation for this application you can open and read here:

Please read my Disclaimer.

080102_PB_01_General_Doc.pdf [30 KB PDF file, download, open, and use at your own risk]

sbRandTrigen (VBA)

Thu, 14 May 2026 15:47:00 +0100

Abstract

Please notice that sbRandTrigen needs and calls sbRandTriang.

Documentation

The documentation for this application you can open and read here:

Please read my Disclaimer.

071228_PB_02_Trigen_Doc.pdf [38 KB PDF file, download, open, and use at your own risk]

Appendix – sbRandTrigen Code

Please read my Disclaimer.

Option Explicit

Function sbRandTrigen(dBottom As Double, dMode As Double, _
    dTop As Double, dBottomPerc As Double, _
    dTopPerc As Double, Optional dRandom = 1#) As Double
'Generates dMin random number, Triang distributed
'with given first and last decile
'[see Vose: Risk Analysis, 2nd ed., p. 129]
'Source (EN): https://www.sulprobil.de/sbrandgeneral_en/
'Source (DE): https://www.berndplumhoff.de/sbrandgeneral_de/
'(C) (P) by Bernd Plumhoff 19-Nov-2011 PB V0.32
'Similar to @RISK's (C) RiskTrigen function.
'sbRandTrigen(bottom, mode, top, bottom percentile, top percentile)
'specifies a triangular distribution with three points — one
'at the mode and two at the specified bottom and top percentiles.
'The bottom percentile and top percentile are values between
'0 and 100. Each percentile value gives the percentile of the
'total area under the triangle that is on the left side of the
'given point.
'Example:
'sbRandTrigen(1,8,10,20,95) will call
'sbRandTriang(-6.13212712795534, 8, 11.8648937411641).
'Please ensure that you execute Randomize before you call 
'this function for the first time.

Static dBottomLast As Double
Static dModeLast As Double
Static dTopLast As Double
Static dBottomPercLast As Double
Static dTopPercLast As Double
Static dMin As Double
Static dMax As Double
Dim dMaxNew As Double
Dim da0 As Double, da1 As Double, da2 As Double
Dim da3 As Double, da4 As Double
Dim dfe As Double, df1e As Double
Dim dBottomPerc2 As Double, dTopPerc2 As Double
Dim i As Long

If dBottom = dBottomLast And dMode = dModeLast And dTop = dTopLast _
   And dBottomPerc = dBottomPercLast And dTopPerc = dTopPercLast _
   And Not IsError(dMin) Then
    sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
    Exit Function
End If

dBottomLast = dBottom
dModeLast = dMode
dTopLast = dTop
dBottomPercLast = dBottomPerc
dTopPercLast = dTopPerc

dBottomPerc2 = dBottomPerc / 100#
dTopPerc2 = 1# - dTopPerc / 100#
If dMode <= dBottom Or dTop <= dMode Then
    dMin = CVErr(xlErrValue) 'Trigger rerun next time
    sbRandTrigen = CVErr(xlErrValue)
    Exit Function
End If
If dBottomPerc2 < 0# Or dTopPerc2 < 0# Then
    dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
    sbRandTrigen = CVErr(xlErrValue)
    Exit Function
End If

If dTopPerc2 = 0# Then
    If dBottomPerc2 = 0# Then
        sbRandTrigen = sbRandTriang(dBottom, dMode, dTop, dRandom)
        Exit Function
    End If
    sbRandTrigen = sbRandTrigen(dBottom, dMode, dTop, dBottomPerc2, dTopPerc2)
    Exit Function
End If

da4 = dBottomPerc2 * dTopPerc2 - dBottomPerc2 + 1# - 2# * dTopPerc2 + dTopPerc2 ^ 2#
da3 = -2# * dBottomPerc2 * dTopPerc2 * dTop - 2# * dBottomPerc2 * dTopPerc2 * dMode - _
      4# * dTop + 4# * dBottomPerc2 * dTop + 2# * dTopPerc2 * dMode + 4# * dTopPerc2 * _
      dTop + 2# * dTopPerc2 * dBottom - 2# * dTopPerc2 ^ 2# * dMode - _
      2# * dTopPerc2 ^ 2# * dBottom
da2 = dBottomPerc2 * dTopPerc2 * dTop ^ 2# + 4# * dBottomPerc2 * dTopPerc2 * dMode * _
      dTop + dBottomPerc2 * dTopPerc2 * dMode ^ 2# - 6# * dBottomPerc2 * dTop ^ 2# + _
      6# * dTop ^ 2# - 4# * dTopPerc2 * dMode * dTop - 2# * dTopPerc2 * dTop ^ 2# - 2# * _
      dTopPerc2 * dBottom * dMode - 4# * dTopPerc2 * dBottom * dTop + dTopPerc2 ^ 2# * _
      dMode ^ 2# + 4# * dTopPerc2 ^ 2# * dBottom * dMode + dTopPerc2 ^ 2# * dBottom ^ 2#
da1 = -2# * dBottomPerc2 * dTopPerc2 * dMode * dTop ^ 2# - 2# * dBottomPerc2 * dTopPerc2 * _
      dMode ^ 2# * dTop + 4# * dTop ^ 3# * dBottomPerc2 - 4# * dTop ^ 3# + 2# * dTopPerc2 * _
      dMode * dTop ^ 2# + 4# * dTopPerc2 * dBottom * dMode * dTop + 2# * dTopPerc2 * _
      dBottom * dTop ^ 2# - 2# * dTopPerc2 ^ 2# * dBottom * dMode ^ 2# - 2# * _
      dTopPerc2 ^ 2# * dBottom ^ 2# * dMode
da0 = dBottomPerc2 * dTopPerc2 * dMode ^ 2# * dTop ^ 2# - dBottomPerc2 * dTop ^ 4# + dTop ^ 4# - _
      2# * dTopPerc2 * dBottom * dMode * dTop ^ 2# + dTopPerc2 ^ 2# * dBottom ^ 2# * dMode ^ 2#
     
dMax = dTop + (dTop - dMode) / (1# - dTopPerc2) ^ 2#

'Newton iteration
Do While Abs(dMaxNew - dMax) > 0.000000000001

    i = i + 1
    If i > 30 Then
        If Abs(dfe) > 0.000000000001 Then
            dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
            sbRandTrigen = CVErr(xlErrValue)
            Exit Function
        Else
            Exit Do
        End If
    End If
    dMaxNew = dMax
    dfe = da4 * dMaxNew ^ 4# + da3 * dMaxNew ^ 3# + da2 * dMaxNew ^ 2# + da1 * dMaxNew + da0
    df1e = 4# * da4 * dMaxNew ^ 3# + 3# * da3# * dMaxNew ^ 2# + 2# * da2 * dMaxNew + da1
    dMax = dMax - dfe / df1e

Loop

dMin = dMax - (dMax - dTop) ^ 2# / dTopPerc2 / (dMax - dMode)
sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
End Function

Download

Please read my Disclaimer.

sbRandTriang (VBA)

Thu, 14 May 2026 14:47:00 +0100

Abstract

The triangular distribution is a continuous probability distribution with a probability density function shaped like a triangle. It is a simple distribution because you only need its mininimum, its median, and its maximum value:

This distribution is sometimes also called the distribution of missing data because you can use it with a minimal given amount of information. It is often used to simulate expert opinions or when it is too difficult or too expensive to gather more data.

sbRandSum1 (VBA)

Thu, 14 May 2026 12:46:00 +0100

Abstract

We present an example of a random number generation with a side condition. The sum of all created random numbers should be 1. This can be achieved by many different approaches.

Three possible approaches are:

Reduce grade of freedom successively: create first random number, then the second one in range[0,1-first), the third one in [0,1-first-second), …, the last will be 1-sum of all others
Create n random numbers and divide them by their sum

sbRandIntFixSum (VBA)

Thu, 14 May 2026 11:46:00 +0100

Abstract

You want to create lCount random integers between a lower boundary lMin and an upper boundary lMax, and they need to sum up to exactly lSum?

This function is similar to sbLongRandSumN.

Please note that you need to include the program sbRandTriang.

Appendix sbRandIntFixSum Code

Please read my Disclaimer.

Option Explicit

Function sbRandIntFixSum(lSum As Long, lMin As Long, _
    lMax As Long, Optional lCount As Long = 0, _
    Optional bUseRandTriang As Boolean = True, _
    Optional bVolatile As Boolean = False) As Variant
'Returns lCount (or selected cell count in case a range is select when
'called as a matrix formula) random integers between lMin and lMax
'which sum up to lSum. If bUseRandTriang the sbRandTriang distribution
'is used to "bias" the randomness to be "less extreme".

'Error values:
'#NUM!   - No solution exists
'#VALUE! - lCount is less than 1
'Source (EN): https://www.sulprobil.de/sbrandintfixsum_en/
'Source (DE): https://www.berndplumhoff.de/sbrandintfixsum_de/
'(C) (P) by Bernd Plumhoff 05-Aug-2020 PB V0.3

Dim i As Long
Dim lRnd As Long, lMinPrev As Long
Dim lRow As Long, lCol As Long

With Application

If TypeName(.Caller) = "Range" And lCount = 0 Then
    lCount = .Caller.Count
    ReDim lR(1 To .Caller.Rows.Count, 1 To .Caller.Columns.Count) As Long
ElseIf lCount < 1 Then
    sbRandIntFixSum = CVErr(xlErrValue)
    Exit Function
Else
    ReDim lR(1 To lCount, 1 To 1) As Long
End If

Randomize
If bVolatile Then .Volatile

For lRow = 1 To UBound(lR, 1)
    For lCol = 1 To UBound(lR, 2)
        lMinPrev = lMin
        lMin = .RoundUp(.Max(lMin, .Min(lSum / lCount, lSum / lCount _
               - (lCount - 1) * (lMax - lSum / lCount))), 0)
        lMax = .RoundDown(.Min(lMax, .Max(lSum / lCount, lSum / lCount _
               + (lCount - 1) * (lSum / lCount - lMinPrev))), 0)
        If lMin > lMax Or lSum / lCount <> .Median(lMin, lMax, lSum / _
            lCount) Then
            'No solution exists
            sbRandIntFixSum = CVErr(xlErrNum)
            Exit Function
        End If
        If bUseRandTriang Then
            If lMin = lMax Then
                lRnd = lMin
            Else
                lRnd = Int(sbRandTriang(CDbl(lMin), _
                       lSum / lCount, CDbl(lMax)) + 0.5)
            End If
        Else
            lRnd = Int(Rnd() * (lMax - lMin + 1) + lMin)
        End If
        lR(lRow, lCol) = lRnd
        lSum = lSum - lRnd
        lCount = lCount - 1
    Next lCol
Next lRow

sbRandIntFixSum = lR
End With

End Function

Sub GenerateRandIntFixSum()
[E7:E27].FormulaArray = sbRandIntFixSum([B1], [B2], [B3], [B4], True, False)
End Sub

Download

Please read my Disclaimer.

sbGrowthSeries (VBA)

Thu, 14 May 2026 10:47:00 +0100

Abstract

You can generate random data with a compound growth rate dblRate, with a maximal relative change rate per step of dblMaxRatePerStep and with an optional start value dblStartVal. The number of periods is implicitly chosen by the number of selected cells which call this function as an array formula (entered with CTRL + SHIFT + ENTER). This is sort of a brownian bridge.

Appendix – sbGrowthSeries Code

Please read my Disclaimer.

Iman Conover (Excel / VBA)

Thu, 14 May 2026 10:41:00 +0100

“When your work speaks for itself, don’t interrupt.” [Henry J. Kaiser]

Abstract

If you need to generate correlated random numbers, the Iman Conover approach is a good method which is to be preferred to the Cholesky decomposition.

In 1982 Iman and Conover published their original article (external link!) “A distribution-free approach to inducing rank correlation among input variables”.

Rick Wicklin wrote in 2021 on (external link!) “Simulate correlated variables by using the Iman-Conover transformation”. His article includes a SAS implementation of the Iman Conover approach.

sbGenerateTeams (VBA)

Thu, 14 May 2026 09:46:00 +0100

“For many people my software is something that you install and forget. I like to keep it that way.” [Wietse Venema]

Abstract

You and your 15 friends want to play in teams of 4 and you wonder how to come up with a fair distribution of teams, because each player has an individual skill level?

Here you go:

This program combines several features which I like to use:

The class SystemState helps to reduce runtime.

sbGenerateTestData (VBA)

Thu, 14 May 2026 08:46:00 +0100

“It is practically impossible to teach good programming style to students that have had prior exposure to BASIC. As potential programmers, they are mentally mutilated beyond hope of regeneration.” [E. W. Dijkstra]

Abstract

The application below is meant to help people who want to test properly.

You want to create six Boolean values, 50% True and 50% False, once in generated order and once shuffled? Here you are:

Or you need to create 4 money values in GBP, the first series between GBP 10 and GBP 20, the second should have an average of 6 and a standard deviation of 2?

UniqRandInt (VBA)

Thu, 14 May 2026 07:46:00 +0100

“Few things are harder to put up with than the annoyance of a good example.” [Mark Twain]

Abstract

Sometimes you need to create random integers without repetition (or with a limited number of repetitions).

Appendix – UniqRandInt Code

Please read my Disclaimer.

'If lRange >> n then set LATE_INITIALISATION to true. For example,
'if lRange=1,000,000 and if 1,000 cells are selected (n=1000).
#Const LATE_INITIALISATION = True
'If random integers may occur more than once, allow repetitions
#Const ALLOW_REPETITION = True

#If ALLOW_REPETITION Then
Function UniqRandInt(n As Long, ByVal lRange As Long, _
  Optional lMaxOccurence As Long = 1) As Variant
#Else
Function UniqRandInt(n As Long, ByVal lRange As Long) As Variant
#End If
'Returns n unique (=non-repeating) random integers within 1..lRange,
'lRange >= n. Set ALLOW_REPETITION = True and call with
'lMaxOccurences > 1 if random integers may occur more than once.
'Source (EN): https://www.sulprobil.com/uniqrandint_en/
'Source (DE): https://www.bplumhoff.de/uniqrandint_de/
'(C) (P) by Bernd Plumhoff 30-Oct-2024 PB V1.04

Static bRandomized As Boolean
Dim vA             As Variant
Dim vR             As Variant
Dim i              As Long
Dim j              As Long
Dim lr             As Long

If Not bRandomized Then
  Randomize
  bRandomized = True
End If

#If ALLOW_REPETITION Then
  If lMaxOccurence < 1 Then
    UniqRandInt = CVErr(xlErrNum)
    Exit Function
  End If
  lRange = lRange * lMaxOccurence
#End If

If n > lRange Then
  UniqRandInt = CVErr(xlErrValue)
  Exit Function
End If

ReDim vR(1 To n) As Variant

ReDim vA(1 To lRange)
#If Not LATE_INITIALISATION Then
  For i = 1 To lRange
    #If ALLOW_REPETITION Then
      vA(i) = Int((i - 1) / lMaxOccurence) + 1
    #Else
      vA(i) = i
    #End If
  Next i
#End If

i = 1
For j = 1 To UBound(vR, 1)
  lr = Int(((lRange - i + 1) * Rnd) + 1)
  #If LATE_INITIALISATION Then
    If vA(lr) = 0 Then
      #If ALLOW_REPETITION Then
        vR(j) = Int((lr - 1) / lMaxOccurence) + 1
      #Else
        vR(j) = lr
      #End If
    Else
  #End If
      vR(j) = vA(lr)
  #If LATE_INITIALISATION Then
    End If
    If vA(lRange - i + 1) = 0 Then
      #If ALLOW_REPETITION Then
        vA(lr) = Int((lRange - i + 1 - 1) / lMaxOccurence) + 1
      #Else
        vA(lr) = lRange - i + 1
      #End If
    Else
  #End If
      vA(lr) = vA(lRange - i + 1)
  #If LATE_INITIALISATION Then
    End If
  #End If
  i = i + 1
Next j

UniqRandInt = vR

End Function

Download

Please read my Disclaimer.

sbRandHistogrm (VBA)

Thu, 14 May 2026 06:46:00 +0100

Abstract

Appendix sbRandHistogrm Code

Please read my Disclaimer.

Function sbRandHistogrm(dmin As Double, dMax As Double, _
            vWeight As Variant, Optional dRandom = 1#) As Double
'Specifies a histogram distribution with range dmin:dmax.
'This range is divided into vWeight.count classes. Each
'class has weight vWeight(i) reflecting the probability
'of occurrence of a value within the class.
'Similar to @Risk's function RiskHistogrm.
'Source (EN): https://www.sulprobil.de/sbrandhistogrm_en/
'Source (DE): https://www.berndplumhoff.de/sbrandhistogrm_de/
'(C) (P) by Bernd Plumhoff 18-Oct-2020 PB V1.01

Dim i As Long, n As Long, vW As Variant
Dim dRand As Double, dR As Double, dSumWeight As Double

With Application.WorksheetFunction
vW = .Transpose(.Transpose(vWeight))
End With

n = UBound(vW)
ReDim dSumWeightI(0 To n) As Double
   
dSumWeight = 0#
dSumWeightI(0) = 0#
For i = 1 To n
    If vW(i) < 0# Then 'A negative weight is an error
        sbRandHistogrm = CVErr(xlErrValue)
        Exit Function
    End If
    dSumWeight = dSumWeight + vW(i) 'Calculate sum of all weights
    dSumWeightI(i) = dSumWeight     'Calculate sum of weights till i
Next i

If dSumWeight = 0# Then  'Sum of weights has to be greater than zero
    sbRandHistogrm = CVErr(xlErrValue)
    Exit Function
End If

If dRandom = 1# Then
    dRand = Rnd()
Else
    dRand = dRandom
End If
dR = dSumWeight * dRand

i = n
Do While dR < dSumWeightI(i)
    i = i - 1
Loop

sbRandHistogrm = dmin + (dMax - dmin) * _
     (CDbl(i) + (dR - dSumWeightI(i)) / vW(i + 1)) / CDbl(n)

End Function

Please read my Disclaimer.

sbLongRandSumN (VBA)

Thu, 14 May 2026 05:46:00 +0100

Abstract

You need to generate 20 non-negative random integers which sum up to 100? Then I suggest to use my UDF below. You can generate an arbitrary number of integers which sum up to a specified amount, and all generated integers are not smaller than another specified number:

Please notice that this function is a relative of sbRandIntFixSum (for which you need to provide non-optional minimum and maximum values to be generated), the brownian bridge sbGrowthSeries, and of sbRandSum1 which generates numbers of type Double which sum up to one exactly. This function is used in my application sbGenerateTestData, for example.

sbExactRandHistogrm (VBA)

Thu, 14 May 2026 04:46:00 +0100

“Chance favours the prepared mind.” [Louis Pasteur]

Abstract

It is fairly easy to create a loaded die, let us say on average the 6 should appear twice as often as all the other numbers 1 thru 5: Enter into A1: =MIN(INT(RAND()*7+1),6)

But what if you want to create 7 rolls of this die and all numbers between 1 and 5 should appear exactly once and 6 exactly twice?

Here is my general solution:

sbRoundRobin (Excel / VBA)

Thu, 14 May 2026 03:33:00 +0100

Abstract

If you need to organize a round robin tournament you can use this subroutine. It implements the circle method:

An example for 6 players:

The VBA program - but not the worksheet function approach - also generates this kind of pairings table:

Cholesky (VBA)

Thu, 14 May 2026 02:46:00 +0100

Abstract

You can generate correlated random variables easily with a Cholesky (pronounce “koleski”) decomposition. I present a simple example here. For the better Iman Conover approach look here.

Appendix – Cholesky and RandCorr Code

Please read my Disclaimer.

Function Cholesky(vA As Variant) As Variant
'I suggest to use the Cholesky decomposition just for purposes of demonstration.
'Better options are (in this order): tred2, tqli, eigsrt from Numerical Recipes.
'SVD also works but is computationally more expensive by far since it does not
'make use of symmetry.
'(Thanks to my former colleague Glen R.)
'Source (EN): https://www.sulprobil.de/cholesky_en/
'Source (DE): https://www.berndplumhoff.de/cholesky_de/
'Bernd Plumhoff 02-Nov-2024 PB V1.1
Dim d As Double
Dim i As Long, j As Long, k As Long, n As Long
With Application.WorksheetFunction
On Error Resume Next
vA = .Transpose(.Transpose(vA))
On Error GoTo 0
n = UBound(vA, 1)
If n <> UBound(vA, 2) Then
  Cholesky = CVErr(xlErrRef)
  Exit Function
End If

ReDim dR(1 To n, 1 To n) As Double 'Zeroing all elements
For j = 1 To n
  d = 0#
  For k = 1 To j - 1
    d = d + dR(j, k) * dR(j, k)
  Next k
  dR(j, j) = vA(j, j) - d
  If dR(j, j) > 0# Then
    dR(j, j) = Sqr(dR(j, j))
    For i = j + 1 To n
      d = 0#
      For k = 1 To j - 1
        d = d + dR(i, k) * dR(j, k)
      Next k
      dR(i, j) = (vA(i, j) - d) / dR(j, j)
    Next i
  Else
    'Cannot continue with usual Cholesky
    'Fill this column with zeros. Idea: Glen R.
    For i = j To n
      dR(i, j) = 0#
    Next i
  End If
Next j
Cholesky = dR
End With
End Function

Function RandCorr(n As Long, vVarCovar As Variant) As Variant
'Returns Ubound(vVarCovar,1) correlated random number vectors of length n.
'vVarCovar is a square matrix containing the variance/covariance matrix.
'Please notice that you will only get a "proxy" correlation, not an exact one.
'Bernd Plumhoff 06-Nov-2009 PB V0.2
Dim vA As Variant
Dim d As Double
Dim i As Long, j As Long, k As Long, m As Long

With Application.WorksheetFunction
vA = .Transpose(.Transpose(vVarCovar))
m = UBound(vA, 1)
If m <> UBound(vA, 2) Then
  RandCorr = CVErr(xlErrRef)
  Exit Function
End If

ReDim Db(1 To m, 1 To m) As Double
For j = 1 To m
  d = 0#
  For k = 1 To j - 1
    d = d + Db(j, k) * Db(j, k)
  Next k
  Db(j, j) = vA(j, j) - d
  If Db(j, j) <= 0 Then
    RandCorr = CVErr(xlErrNum)
    Exit Function
  End If
  Db(j, j) = Sqr(Db(j, j))
  
  For i = j + 1 To m
    d = 0#
    For k = 1 To j - 1
      d = d + Db(i, k) * Db(j, k)
    Next k
    Db(i, j) = (vA(i, j) - d) / Db(j, j)
  Next i
Next j

ReDim vR(1 To n, 1 To m) As Variant
For i = 1 To n
  For j = 1 To m
    vR(i, j) = .Norm_S_Inv(Rnd())
  Next j
Next i
vR = .MMult(vR, Db)
RandCorr = vR
End With
End Function

Download

Please read my Disclaimer.

Named Ranges Used in a Different Way (Excel)

Thu, 14 May 2026 02:33:00 +0100

Abstract

In general you will use named ranges in Excel to avoid hard coded references to input cells or to output cells. If you assign names to important cells, the references to them will be automatically updated in case of insertions or deletions of rows or columns.

Here we like to use named ranges in Excel to efficiently implement a simple solution with nested worksheet formulas which do not need future amendments:

sbRandInt (VBA)

Thu, 14 May 2026 01:46:00 +0100

Abstract

If you want to generate non-repeating (or repeating up to lRept times) random integers between two given values I suggest to use my UDF sbRandInt:

Appendix – sbRandInt Code

Please read my Disclaimer.

Function sbRandInt(ByVal lCount As Long, _
  lMin As Long, _
  lMax As Long, _
  Optional lRept As Long = 1) As Variant
'Returns lCount random integers between lMin and lMax, each one
'occurring zero to lRept times. lMax - lMin + 1 must be greater
'or equal to lCount.
'Error values:
'#NUM!   - lRept is less than 1
'#REF!   - lCount is greater than (lMax - lMin + 1) * lRept
'#VALUE! - lCount is less than 1
'Source (EN): https://www.sulprobil.de/sbrandint_en/
'Source (DE): https://www.berndplumhoff.de/sbrandint_de/
'(C) (P) by Bernd Plumhoff  30-Dec-2024 PB V1.02
Static bRandomized As Boolean
Dim i As Long, j As Long, k As Long
Dim lRnd As Long, lRange As Long
Const CLateInitFactor = 50

If lCount < 1 Then sbRandInt = CVErr(xlErrValue): Exit Function
If lRept < 1 Then sbRandInt = CVErr(xlErrNum): Exit Function
If lCount > (lMax - lMin + 1) * lRept Then sbRandInt = CVErr(xlErrRef): Exit Function

lRange = (lMax - lMin + 1) * lRept

ReDim lr(1 To lCount) As Long

If Not bRandomized Then Randomize: bRandomized = True

ReDim lT(1 To lRange) As Long
'If we have a huge range of possible random integers and a comparably
'small number of draws, i.e. if (lMax - lMin) * lRept >> lCount
'then we can save some runtime with late initialization.
If lRange / lCount < CLateInitFactor Then
  For i = 1 To lRange
    lT(i) = Int((i - 1) / lRept) + lMin
  Next i
End If

i = 1
If lRange / lCount < CLateInitFactor Then
  For k = 1 To UBound(lr)
    lRnd = Int(((lRange - i + 1) * Rnd) + 1)
    lr(k) = lT(lRnd)
    lT(lRnd) = lT(lRange - i + 1)
    i = i + 1
  Next k
Else
  j = lMin: If lMin <= 0 And lMax >= 0 Then j = 1
  For k = 1 To UBound(lr)
    lRnd = Int(((lRange - i + 1) * Rnd) + 1)
    If lT(lRnd) = 0 Then
      lr(k) = Int((lRnd - 1) / lRept) + j
    Else
      lr(k) = lT(lRnd)
    End If
    If lT(lRange - i + 1) = 0 Then
      lT(lRnd) = Int((lRange - i) / lRept) + j
    Else
      lT(lRnd) = lT(lRange - i + 1)
    End If
    i = i + 1
  Next k
  'If lRange includes zero we need to shift result array
  If lMin <= 0 And lMax >= 0 Then
    For k = 1 To UBound(lr)
      lr(k) = lr(k) + lMin - 1
    Next k
  End If
End If

sbRandInt = lr

End Function

Please read my Disclaimer.

SystemState (VBA Class)

Wed, 13 May 2026 14:30:00 +0100

Abstract

“Any sufficiently advanced technology is indistinguishable from magic.” [Arthur C. Clarke]

My former colleague Jon T. created the smallest reasonable class module I have seen so far: SystemState provides an easy way to save and to restore system state variables like Calculation, ScreenUpdating and others.

To speed up your code you normally write at the beginning of a VBA macro

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

and at the end of a macro

Take Vacation when less is going on (Excel / VBA)

Wed, 13 May 2026 06:56:00 +0100

Abstract

If your business fluctuates strongly seasonally, you can plan the vacation of your staff accordingly and consider hiring seasonal staff:

Note: Of course you cannot force anybody when to take a vacation and how many days are to be taken. These calculations are just meant to be suggestions of reasonable indicators.

Simple Example

If you like to take the maximum sales values (here: 24,000) as a basis, applying zero vacations to it, and scale the vacation days linearly to the other sales values:

Tip Distribution (Excel)

Wed, 13 May 2026 06:50:00 +0100

“Flattery is nice but tips will suffice.”

Abstract

You want to split tips fairly between your employees? They may keep 70% of all tips they get directly but 30% should be distributed based on hours worked so that cleaners and reception staff would receive a share, too?

The percentage of what everybody can keep:

Download

Please read my Disclaimer.

Tip_Distribution.xlsx [48 KB Excel file, open and use at your own risk]

Compare Correlation Matrices (Perl)

Sun, 10 May 2026 15:44:00 +0100

“Remember, my friend, that knowledge is stronger than memory, and we should not trust the weaker.” [Bram Stoker]

Abstract

Some years ago I developed a Perl program for an Algorithmics client. Over time I enhanced this program and I made it read the RMLinks.cfg file so that new risk factors would be included automatically.

Implementation Approach

My implementation approach was:

1. Read first matrix
    Checks:
    Matrix quadratic?
    Risk factor order left->right (top row) == top->bottom (leftmost column)?
    Diagonals == 1 (warning)?
    No NC category (warning if there is)?
    Matrix symmetric: M(i,j) == M(j,i) for all i,j?
    [Not for DC files because not given there.]

2. Read second matrix
    Checks identical to above

3. Risk factors in both matrices identical?
    Warn about risk factors which are in first matrix but not in second and vice versa
    Highlight outliers per category
    Highlight outliers per currency

Parameters

b - breaches: do not report differences between the two input matrices but breaches beyond tolerances.
d - debug [level] gives debugging information at detail level level
    level 1: -
    level 2: -
    level 3: Print all elements of matrices 1 and 2
f - read deviation file [-f needs to be followed by a valid filename]
    Reads min and max values for all slices for differences which should
    be ignored during comparison. See option -w to get format example
h - help: list parameters and their explanation
i -  ignore risk factors in a given file [-i needs to be followed by a valid filename]
m - set max rank index [default is 6 (=return highest 3
    and lowest 3 of each slice); m needs to be even and >= 4 !
n - tolerate risk factor category NC
r - set Algo risk factor category file [default is ./RMLinks.cfg
s - summarize findings, no detailed warnings or error messages
t - read file with tolerated changes for each matrix element and apply tolerance check
v - print version
w - write deviation file with min and max values of all slices.
    This file is comma-separated to be easily readable via Excel.
    It can be amended and used with option -f later
    [-w needs to be followed by a valid filename, preferrably ending with .csv
x - read translation table [-x needs to be followed by a valid filename].
    Risk factor names of matrix 1 will be translated by second name in comma-separated row

Program Call Example

A typical call of this program from a Shell script could look like:

sbDataStats (VBA)

Sun, 10 May 2026 15:44:00 +0100

“Statistics are like bikinis. What they reveal is suggestive, but what they conceal is vital.” [Aaron Levenstein]

Abstract

Of course you could write a data checking program for any specified input.

But what if you would like to throw any arbitrary data (given in a csv file!) into a general data analyzer?

For numerical data a general analysis could easily produce minimum, average, and maximum information and also warn if any extreme value differs from the average by more than 2.5 standard deviations, for example. For text data an analysis program could print text frequency and character frequency information.

Hugo (HTML)

Sun, 10 May 2026 13:33:00 +0100

“I am always doing things I can’t do, that’s how I got to do them.” [Pablo Picasso]

Abstract

I do not run a web shop and I do not need a database to refresh dynamic web pages. That’s why I use Hugo to run my web sites sulprobil.de and (external link!) berndplumhoff.de.

Hugo is quite efficient. The web pages will be translated quickly. The generated web pages will be loaded quickly, and they are well readable on a computer as well as on smart phones.

Successful Teams

Sun, 10 May 2026 13:22:00 +0100

“Teamwork is the secret that makes common people achieve uncommon results.” [Ifeanyi Onuoha]

Overview

In homogeneous teams, members have similar personalities and strengths.
There are few conflicts, but the results are often suboptimal.
The more diverse the roles within a team, the more powerful the team becomes.
If team members are aware of this distribution, it further improves outcomes.
There are many different approaches to putting together successful working groups.

Adonis (BPM)

Wed, 06 May 2026 06:25:00 +0100

“Lack of documentation is becoming a problem for acceptance.” [Wietse Venema]

Abstract

Adonis is a business process management tool. It was developed at the University of Vienna in 1995. Adonis offers documentation, analysis, and optimization functionality for business processes.

Access and Usage

Companies can aquire a regular (external link!) Adonis license. Private persons can use (external link!) Adonis:CE free of charge.

(External Link!) Adonis User Manual is a detailed online user manual.

Limitations of the free Adonis:CE

After 60 days without login your Adonis:CE account will be deactivated.

Pólya - How to Solve It

Fri, 10 Apr 2026 13:11:00 +0100

“If there is a problem you can’t solve, then there is an easier problem you can solve: find it.” [George Pólya]

Abstract

Anyone looking to solve problems in a structured way should start by reading How to Solve It by George Pólya.

While Pólya focused primarily on mathematical problems, his methods are broadly applicable to problem-solving in general.

Pólya’s Principles

In his book, Pólya outlines four basic phases of problem-solving.

Employee Revenue Shares (Excel / VBA)

Fri, 13 Mar 2026 14:14:00 +0100

Abstract

This application is a simple example of a revenue report. It is using my preferred programming elements.

Input:

Output:

How to identify your most important clients and employees at a glance (see green background):

With the clients GHI GmbH & Co KG and DEF AG, you generate more than 50% of your total revenue.
Your employees Emp2 and Emp1 generate more than 50% of your total revenue.

The goal was a simple and transparent reporting process: Which employees had which revenue shares for which clients, and who created which revenue report, when, and with what result.
The scripting dictionaries oStaff, oStaffSum, oClient, oClientSum, and oSum allow for easy collection, storage, and output of all numerical and non-numerical data using non-numeric keys.
The output data is provided both in the worksheet Output and in the subdirectory Reports, and is additionally zipped into an annual archive by the subroutine sbZip.
The function RoundToSum ensures error-free rounding of employee shares.
The enumeration input_columns allows for understandable addressing and easy future modification of the input columns.
The modLog module and clsLog class module show who created which revenue report, when, and with what result. See the Workflow worksheet and the Logs subdirectory.
The class module SystemState sets the desired environment parameters at program start and resets them after execution.
The application addresses the worksheets directly using VBA internal code names (wsI, wsO, wsW).
Invalid inputs and inconsistent output totals are highlighted in yellow and logged.
The module (external link!) LibFileTools ensures this application also runs under SharePoint / OneDrive.
The module (external link!) TimeZone provides conversions between time zones – the prerequisite is a properly installed MS Outlook.
The modules (external links!) modPerf and modTimer, along with the class module clsPerf, enable the measurement of the runtime of subroutines and functions – for this, the precompiler constant MEASURE_RUNTIME = True must be set.
If another application can provide the input data (e.g., revenues per client, employee time tracking multiplied by their seniority as weights) as a file, this application should be extended with an InputFiles subdirectory containing yearly subfolders (analogous to the existing output structure).
Detailed documentation of this application is easily possible using the BPM system Adonis.

Download

Please read my Disclaimer.

Competence at Work

Sat, 27 Sep 2025 16:15:00 +0100

“There is only one proof of ability: doing it.” [Marie von Ebner-Eschenbach]

Abstract

Do you want to convince your boss of your excellent performance? Or, as a boss, do you need to allocate your staff to various teams based on their skills?

The book “Competence at Work” by Lyle M. Spencer and Signe M. Spencer can help. Originally intended to aid companies and HR departments in successful staff selection, this book presents necessary competencies for different working profiles with scale values.

Risk Analysis

Sat, 27 Sep 2025 16:12:00 +0100

“Knowledge is the only instrument of production that is not subject to diminishing returns.” [John Clarke]

Abstract

This exercise was given by Nidal Sh., a former colleague of mine. I think it is a very useful exercise to sharpen your understanding for data and for risk in general.

Scenario:

You are a fund manager (FX, Real Estate, Equities or Fixed Income). You need to perform two presentations:

a) Show your CEO that your fund is very risky compared to the other ones. You need more capital, budget and other resources to deal with that properly.

Staff Task Matrix

Sat, 27 Sep 2025 16:11:00 +0100

Abstract

In case you need to coordinate a team:

Prioritize each task and give it a value due to necessary knowledge, thinking, and responsibility involved.

A responsible employee must be defined for each task. Insert 2 in corresponding row/column. In case of normal ongoing business define a substitute, too. Insert 1 for any sub. Substitutes can be omitted for project tasks or tasks which are rarely executed.

In our example Antony is team head. He has the highest point sum. Cesare is Antony’s deputy.

Project Management (PRINCE2)

Sat, 27 Sep 2025 16:08:00 +0100

“Assumption is the mother of all f***-ups.” [Everett McGill when playing Marcus Penn]

Abstract

Project management is the discipline of organizing and managing resources so that a project is completed within defined cost, quality, scope & time constraints. A project is a temporary and one-time undertaking to create a product or service which provides beneficial change or added value.

The responsible person to organize and to control a project is called project manager. There are some organizations which train necessary and useful project management skills. See, for example for PRINCE2 (external link!):

Book Leather Care

Sat, 27 Sep 2025 16:05:00 +0100

“A truly great book should be read in youth, again in maturity and once more in old age.” [Robertson Davies]

Disclaimer

Please read my Disclaimer.

Abstract

Leather bookbinding is sensitive. If not properly cared for, it dries out, becomes brittle, and cracks. Every 4 years, it should be treated with a suitable leather care product. The recipe presented here can be made at any pharmacy. It comes from a librarian of a library in Göttingen.

Posts on Sulprobil

sbGetCell (VBA)

Abstract

Test Date Formulas (Excel)

Abstract

Example

sbEAN (VBA)

Abstract

See also

Appendix sbEAN Code

Download

sbSpellNumber (VBA)

Abstract

Appendix – sbSpellNumber / sbInWorten Code

Download

Optimal Usage of Vacation Days (VBA)

Abstract

sbTasklist (VBA)

Abstract

RoundToSum (VBA)

Rounding Values Preserving Their Sum

sbZip (VBA)

Abstract

Appendix – sbZip Code

Download

Krabat (Excel)

Abstract

Download

sbNRN (VBA)

Abstract

Excel VBA A Collection (Excel / VBA)

Excel VBA A Collection

sbCollatz (VBA)

Abstract

Example

Appendix – sbCollatz Code

sbDec2Bin (VBA)

Abstract

Extended Euklidean Algorithm (VBA)

Abstract

sbMinCash (VBA)

Abstract

Accounts Receivable Problem (VBA)

Abstract

sbInterp (VBA)

Abstract

Appendix – sbInterp Code

Download

Options (VBA)

Abstract

Mortality Annuities (Excel, VBA)

Abstract

Complex Array Formula (Worst)

Simple user defined function in VBA (Better)

Pre-calculated Table plus an NPV Formula (Maybe Best)

QuickPerm (Excel / VBA)

Abstract

Example

Combinations with Subsets k of n (Excel / VBA)

Abstract

Example

Literature

Fix Sum from Random Corridors (Excel)

Abstract

The Distribution of the Random Numbers

PF_Allocate (VBA)

Abstract

Appendix – PF_Allocate Code

Download

Linear Equations with Rational Coefficients (VBA)

Abstract

See also

Literature

Create statistics for weighted values (VBA)

Statistics for Weighted Values

Example

Appendix - sbSWV Code

Download

ApplicationVersion (VBA)

Abstract