EDV Abmayr: Excel Macros

English
Deutsch / German
This page contains some commonly useful macros for Microsoft Excel. Diese Seite enthält einige allgemein nützliche Makros für Microsoft Excel.
What are Excel macros? Excel macros are programs which use the cells of an Excel table to work with them. They can read the content of those cells and perform calculations on it and store the result in others cells. And there are many other things macros can be used for. Macros also can be used with other programs (Microsoft Word, Outlook, ...) to perform tasks that occur often.
Sample: If you want to insert your address (or any other standard text) in a Microsoft Word document, this can be done by just typing one key combination that is assigned to such a macro.
Was sind Excel Makros? Excel Makros sind Programme, die die Zellen einer Excel-Tabelle benutzen, um sie zu lesen, mit den Werten Berechnungen durchzuführen und die Ergebnisse in andere Zellen zu schreiben. Und es gibt noch vieles andere, was diese Makros können. Makros können auch in anderen Programmen benutzt werden (Microsoft Word, Outlook, ...), um wiederkehrende Aufgaben schnell zu erledigen.
Beispiel: Wenn Sie Ihre Adresse oder einen anderen Textbaustein in ein Microsoft Word Dokument einfügen möchten, brauchen Sie dazu nur eine einzige Tastenkombination drücken, die solch einem Makro zugewiesen ist.
How to use macros? Just type the key combination that is assigned to the desired macro. Or you open a list with the available macros using Alt-F8 and select one. Wie benutzt man Makros? Sie drücken nur die Tastenkombination, die dem gewünschten Makro zugewiesen ist, und schon wird es ausgeführt. Oder Sie öffnen eine Liste mit den verfügbaren Makros mit Alt-F8 und wählen daraus das gewünschte Makro aus.
Security: Macros are powerful programs and can be used to perform many things in your computer which would not be good for you. This is the reason why you should be extremly cautious whenever you get a file for Excel or Word. Even if you know the author of the file, this file can contain harmfull macros without the author's knowledge. They can contain macros that steal data from you computer or damage them. Therefore macros should be disabled for all users who don't need them. You can do this in Excel's Option menu, where you can find the settings for macro security.
Macros can be attached to emails, too. If you open the attachment of such an mail, the macro can be executed automatically (depending on your settings). This caused big troubles already even in companies that should have big knowledge about such things.
---> Be sure to understand the security problem with macros before installing them on your computer!
This is the reason, why you cannot download my macros in a file. You would not be able to check the harmlessness before downloading. If you copy the macros text out of this document, you can check the code before you use it.
Sicherheit: Makros sind Programme, die viele Dinge in ihrem Computer anstellen können, was nicht gut für Sie wäre. Das ist der Grund, warum Sie sehr vorsichtig sein sollten, wenn Sie eine Datei für Excel oder Word bekommen. Selbst wenn Sie den Ersteller der Datei kennen, kann die Datei schädliche Makros enthalten, ohne daß es der Ersteller weiß. Solche Dateien können Makros enthalten, die Ihre Daten von Ihrem Computer stehlen oder sie beschädigen. Deshalb sollten Makros für alle Benutzer ausgeschaltet werden, die sie nicht brauchen. Sie können das in Excel im Options-Menü tun. Dort gibt es einen eigenen Bereich für die Makro-Sicherheit.
Macros können auch als Anhang mit E-Mails versendet werden. Wenn Sie einen solchen Anhang öffnen, kann das Makro (je nach Sicherheitseinstellungen) automatisch ausgeführt werden. Das hat schon größte Probleme in Firmen verursacht, die sich eigentlich mit diesen Dingen auskennen sollten.
---> Bevor Sie diese ungemein nützlichen Makros benutzen, sollten Sie unbedingt diese Sicherheitsproblematik verstanden haben!
Das ist der Grund, warum Sie meine Makros nicht als Datei herunterladen können. Dann wären Sie nicht in der Lage, sich von deren Harmlosigkeit zu überzeugen, bevor Sie auf ihren Rechner gelangen. Wenn Sie den Makro-Text aus dieser Seite kopieren, können Sie sich hingegen schon vorher von der Unbedenklichkeit überzeugen.
How to install macros? Enabling the usage of macros and installation of new macros require some knowledge on programming and computer maintenance. Therefore it should be done by those who know how to do it. Wie werden Makros installiert? Die Ermöglichung der Benutzung von Makros und die Installation neuer Makros erfordern Kenntnisse in der Programmierung und Wartung von Computer. Deshalb sollte es von Leuten gemacht werden, die wissen, wie es geht. Aus diesem Grund hielt ich es für überflüssig, eine deutsche Dokumentation der Makros zu erstellen.
How to get macros? The internet provides many pages with helpful macros! If you have very special requirements you need a programmer to write a macro for you. Woher bekomme ich macros? Im Internet gibt es viele Seiten mit nützlichen Makros. Wer aber sehr spezielle Anforderungen hat und selbst nicht programmieren kann, kann sich Makros von Fachleuten programmieren lassen.
Exclusion of liability: The user of the macros is alone responsible for the results, I herewith deny any liability of my person! These macros can contain program errors. Many macros overwrite the content of special cells. This content is lost, as the execution of macros cannot be undone.
Tip: Test new macros with a sample file. Save the file before executing a macro. Then the file can be reloaded, if the result was bad.
Haftungsausschluß: Wer diese Makros benutzt, ist selbst für die Folgen verantwortlich, ich übernehme dafür keinerlei Haftung! Diese Makros können Programmierfehler enthalten. Viele Makros überschreiben den Inhalt bestimmter Zellen, der dann verloren ist, weil die Ausführung von Makros nicht rückgängig gemacht werden kann.
Tip: Vor Anwendung von Makros diese an einer Beispieldatei testen und die Datei abspeichern, damit sie bei unerwünschten Folgen wieder neu geladen werden kann.
Copyright: These macros may be copied, used and modified freely for private and other not commercial purpose. You may give them or parts of them freely to others only together with the information about the author, the exclusion of liability and the copyright. These macros or parts of them must not be sold and they must not be used for commercial purpose without permission of the author. For this you need a license (contact) after testing the macro for your purpose for a maximum of 2 weeks. Copyright: Diese Makros dürfen kostenlos für private und andere nicht-kommerzielle Zwecke (z.B. in Vereinen) kopiert, verwendet und an Ihre Bedürfnisse angepaßt werden. Die Makros oder Teile davon dürfen nur zusammen mit den Angaben über Autor, Haftungsausschluß und Copyright unentgeltlich (bis auf ein Dankeschön für die gute Empfehlung) an andere weitergegeben werden. Diese Makros oder Teile davon dürfen ohne Zustimmung des Autors nicht verkauft werden. Wenn Sie die Makros oder Teile davon für kommerzielle Zwecke einsetzen möchten, benötigen Sie dafür eine Lizenz des Autors (Kontakt), nachdem sie das Makro maximal 2 Wochen für Ihren Einsatz getestet haben.
Errors and improvements: If you are very sure that you have found an important error or improvement, it would be nice if would you send me a mail with a accurate descriptioin. Please do not send any Excel files with macros, because I will never open it! Just describe it in a plain text mail. Thank you!

Please understand that I can offer no service for the macros if you use it without paying for it.
Fehler und Verbesserungen: Wenn Sie sich ganz sicher sind, daß Sie einen wichtigen Fehler oder eine Verbesserung gefunden haben, wäre es nett, wenn Sie mir eine E-Mail mit einer genauen Beschreibung schicken würden. Bitte senden Sie keine Excel-Daten mit Makros als Anhang, weil ich diese nicht öffne! Beschreiben Sie Ihren Fund bitte in einer einfachen Text-Mail. Vielen Dank!

Bitte haben Sie Verständnis dafür, daß ich für diese Makros im Falle der kostenfreien Verwendung keinen Service anbieten kann.





List of macros with short description

Name of Macro Description
jumpToCellsOfFormula If you select any cell containing a function and run the macro jumpToCellsOfFormula, a new window will be opened that displays all cells that are used in the function. And if you click onto a line for such a cell, the macro will locate this cell in your worksheet and jump to this cell!
add_to_content, restore_contents_table
English Documentation Generate a table of contents for an Excel file. Then you can navigate very quickly to the cells which you want to see, instead of scrolling through multiple worksheets, rows and columns.
add_to_contents: Add selected cell to the table of contents.
restore_contents_table: Add cells with cell names to the table of contents.
Deutsche Dokumentation Erzeugt ein Inhaltsverzeichnis für eine Excel-Datei. Dann können Sie sehr schnell zu den gewünschten Zellen springen, ohne durch viele Arbeitsblätter und große Zellbereiche navigieren zu müssen.
add_to_contents: Füge die ausgewählte Zelle zum Inhaltsverzeichnis hinzu.
restore_contents_table: Füge Zellen mit Zell-Namen zum Inhaltsverzeichnis hinzu.
The code with more detailed descriptions can be found below.

I inserted all functions into this single page, as many of the advanced macros use other ones. Use the find function of the browser to search for a special macro!


jumpToCellsOfFormula

There is one function which might be unbelievable useful for you if you write many functions in Excel. If you select any cell containing a function and run the macro jumpToCellsOfFormula, a new window will be opened that displays all cells that are used in the function. And if you click onto a line for such a cell, the macro will locate this cell in your worksheet and jump to this cell! This window looks like this:

Each line consists of multiple entries. The first line contains the data of the cell with the formula and at the end the formula itself, which may be too long to be displayed completely. All other lines contain the data for one cell of the formula, the order is just as they appear in the formula. The entries in the lines are:

  1. (optional) name of the workbook. If the workbook is open, it is just the filename, if it is not open, it is the complete path. If this name is supplied, it is surrounded by brackets []. If the name is not supplied, it is the same as in the first line.
  2. (optional) name of the worksheet. If this name is supplied, an ! will be appended. If the name is not supplied, it is the same as in the first line and there is only a !
  3. column number
  4. row number
  5. cell name: either the column letter with the row number, or the name of the cell, if this is specified. Here it is displayed how it occurs in the formula.
  6. value of the cell: if the value is not valid, ERROR is print instead. This is one of the most useful functions of this macro. If you see that your function result is errornous, you can easily find the errornous cell with this macro!
  7. cell name: If a name is defined for the cell, this is displayed here.
  8. part of formula: The last entry is the part of the formula that was used to calculate the data for the cell of this line. This can be used to find errors, if the macro does not work properly

REMARKS:
Sub jumpToCellsOfFormula()
' Analyze the formula of the selected cell and write all cells (column, row, value, name)
' to a user form window of type CellSelectionListbox which is displayed modeless.
' So you can work in the worksheet while this dialog is displayed.
' IMPROVE: * support of relative numbering of cells
'          * find cells in other sheets
'          * update button in dialog to reload the values of the displayed cells
'          * horiz + vert scrollbar ins listbox

Const LB_FILL_CHAR = " "    ' Fill leading number characters in the listbox with the char.
                           ' If it is empty string, no leading characters are added.

Dim pos As Integer          ' position in string
Dim formula As String       ' formula string
Dim row, col As Integer     ' position of cell
Dim row_sel, col_sel As Integer     ' position of originally selected cell
Dim char As String          ' Ein Zeichen im String
Dim column_string As String ' the column name as string (may be 1 or 2 characters)
Dim row_string As String    ' the row number as string (may be several characters)
Dim found As Integer        ' 1: found a valid cell    2: found end of formula     0: else
Dim info_wnd As CellSelectionListbox      ' self generated user form
Dim line As String
Dim cell_value As String


' Generate list of all names of cells or ranges. Later we look in this list
' whether the range matches any cell in the formula
Set namelist = ActiveWorkbook.Names

' We could use the cell comments instead of names. Using the names has the advantage,
' that we could use the cell names in formulas too.
'c1 = ActiveCell.comment.text    ' -> Bernhard Abmayr:comment 1
'c1 = ActiveCell.comment.Application    ' -> Microsoft Excel
'c1 = ActiveCell.comment.Author    ' -> Bernhard Abmayr
'c1 = ActiveCell.comment.Creator    ' -> große Zahl
'c1 = ActiveCell.comment.Parent    ' -> 4
'c1 = ActiveCell.comment.Shape    ' -> invalid
'c1 = ActiveCell.comment.Visible    ' -> false
'c1 = ActiveCell.comment.Next    ' -> invalid
'c1 = ActiveCell.name                ' liefert die Adresse statt des Namens. Deshalb müssen
                                     ' wir die Namensliste benutzen

If ActiveCell.HasFormula = False Then
    MsgBox ("This cell does not contain a formula.")
    Exit Sub
End If

pos = 0
formula = ActiveCell.formula
row_sel = ActiveCell.row
col_sel = ActiveCell.Column

'-----------------------------------------------------------------------------------------
' Open the user form and write the data of the cell with the function into the first line
'-----------------------------------------------------------------------------------------
Set info_wnd = New CellSelectionListbox
'info_wnd.infotext = "Found cell in formula."
info_wnd.StartUpPosition = WindowsDefault             ' links oben
info_wnd.Caption = "Loop Cells Of Formula"
'info_wnd.cell_list.ColumnCount = 5       ' multiple columns need more space
'info_wnd.cell_list.ColumnHeads = True
If IsError(ActiveCell.value) Then
    cell_value = "error"
Else
        If IsNumeric(ActiveCell.value) Then
            cell_value = FormatNumber(ActiveCell.value, 2)
        Else
            cell_value = ActiveCell.value
        End If
End If
line = col_sel & " | " & row_sel & " | " & column_name(col_sel) & row_sel & "   | " & cell_value & "   | " & formula
info_wnd.cell_list.AddItem (line)
' There is no optimum fond for the cell list. Monospaced fonts (Courier New, Lucida,
' Terminal) are too wide. If we reduce the size (<8) the characters become too small.
' So we use Tahoma which is narrow, but not monospaced.
info_wnd.Show (vbModeless)          ' vbModeless vbModal
'info_wnd.cell_list.DisplayHorizontalScrollBar = True   ' Compiler meckert.

'-----------------------------------------------------------------------------------------
' search next cell in formula: first search letter, then search number
'-----------------------------------------------------------------------------------------
' 1) search letter
'-----------------------------------------------------------------------------------------
search_letter:
found = 0
column_string = ""
Do
    pos = pos + 1
    If pos <= Len(formula) Then
        char = Mid(formula, pos, 1)
        If char >= "A" And char <= "Z" Then
            column_string = column_string + char
        ElseIf char = "$" Then    ' this may preceed the number, but is ignored here
            found = 1
        ElseIf char >= "0" And char <= "9" And Len(column_string) > 0 Then
            found = 1
            pos = pos - 1          ' the position will be increased before fetching next char
        ElseIf char = "(" Then     ' the letters are a function name
            column_string = ""
        Else                       ' if the function does not work, look here which characters are not worked up properly
            column_string = ""
        End If

    Else
        found = 2
    End If

Loop Until found > 0

'-----------------------------------------------------------------------------------------
search_number:
'-----------------------------------------------------------------------------------------
row_string = ""
If found = 1 Then
    found = 0
    Do
        pos = pos + 1
        If pos <= Len(formula) Then
            ' We could convert here immediately with CLng, but then we do not know where to
            ' continue with the next character!
            char = Mid(formula, pos, 1)
            If char >= "0" And char <= "9" Then
                row_string = row_string + char
            Else
                If Len(row_string) > 0 Then
                    found = 1
                Else                   ' found letters without trailing number -> restart search
                    row_string = ""
                    pos = pos - 1
                    GoTo search_letter
                End If
            End If

        Else
            If Len(row_string) > 0 Then
                found = 1
            Else
                found = 2
            End If
        End If

    Loop Until found > 0
End If ' found = 1

'-----------------------------------------------------------------------------------------
' write cell data to listbox
'-----------------------------------------------------------------------------------------
If found = 1 Then
    ' Fill cell data in listbox
    row = CLng(row_string)
    col = column_number(column_string)
    If IsError(ActiveSheet.Cells(row, col).value) = True Then
        cell_value = "error"
    Else
        If IsNumeric(ActiveSheet.Cells(row, col).value) Then
            cell_value = FormatNumber(ActiveSheet.Cells(row, col).value, 2)
        Else
            cell_value = ActiveSheet.Cells(row, col).value
        End If
    End If


    line = FormatNumberRight(col, "###", 3, LB_FILL_CHAR) & " |" _
         & FormatNumberRight(row, "#####", 5, LB_FILL_CHAR) & " |" _
         & format(column_string, "@@") & row_string & " | " & cell_value
    For i = 1 To namelist.Count
        If namelist(i).RefersToRange.Column = col And _
           namelist(i).RefersToRange.row = row Then
           line = line & " | " & namelist(i).name
        End If
    Next i

    info_wnd.cell_list.AddItem (line)
    'ActiveSheet.Cells(row, col).Select
    GoTo search_letter           ' continue with next cell in the formula

ElseIf found = 2 Then
    'MsgBox ("reached end")
Else
    MsgBox ("FOR PROGRAMMER: Illegal value of found: " & found)
End If

End Sub

Responsible: Bernhard Abmayr of EDV Abmayr. Last change: November, 26th, 2010