Useful VBA Functions For Excel

There are plenty of ways to connect Excel with SAP using VBA. The code provided here is meant only to comprise a simple repository wherefrom snippets can be recycled at will.

Functions to handle tabs in Excel

When it comes to managing tabs, having and few snippets of code to create, find and delete them simplifies each of these processes. The naming and code make the functionality of each obvious, so few remarks are included.

Function CreateTab(strTabName) As Worksheet
    Dim objCurrentSheet As Worksheet
    For Each objCurrentSheet In Sheets
        If objCurrentSheet.Name = strTabName Then
            Application.DisplayAlerts = False
            objCurrentSheet.Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next
    Set CreateTab = Sheets.Add  
    CreateTab.Name = strTabName
End Function

Function GetTab(strTabName) As Worksheet
    Dim objCurrentSheet As Worksheet
    For Each objCurrentSheet In Sheets
        If objCurrentSheet.Name = strTabName Then
            Set GetTab = objCurrentSheet
            Exit Function
        End If
    Next
    Set GetTab = Sheets.Add 
    GetTab.Name = strTabName
End Function

Function NukeTab(strTabName) As Boolean
    Dim objCurrentSheet As Worksheet
    For Each objCurrentSheet In Sheets
        If objCurrentSheet.Name = strTabName Then
            Application.DisplayAlerts = False
            objCurrentSheet.Delete
            Application.DisplayAlerts = True
            NukeTab = True
            Exit Function
        End If
    Next
    NukeTab = False
End Function

Function ActivateTab(strTabName As String) As Boolean
    'Sort the tabs to keep them neat.
    Dim nCurrent As Long, nCurrent2 As Long
    Dim wsA As Worksheet, wsB As Worksheet
    For nCurrent = 1 To Sheets.Count - 1
        For nCurrent2 = nCurrent + 1 To Sheets.Count
            If Sheets(nCurrent).Name = strTabName Then
                'Do nothing...
            ElseIf Sheets(nCurrent2).Name = strTabName Then
                'Sheets(nCurrent2).Move (Sheets(ncurrent1))
                Sheets(nCurrent2).Move before:=Sheets(nCurrent)
            Else
                If Len(Sheets(nCurrent2).Name) < Len(Sheets(nCurrent).Name) Then
                    Sheets(nCurrent2).Move before:=Sheets(nCurrent)
                End If
            End If
        Next
    Next
    Sheets(strTabName).Activate
    retval = DoEvents
End Function

Finding the address of a Cell based on Column and Row as numeric values

When adding values to Cells in Excel, it is sometimes easier to think of them as X and Y coordinates. This function takes the number of the column as a Long Integer starting at one for "A" and the Row as a Long Integer and returns a Cell address like "GZ2038".

This code seems trivially simple, but it has worked for this programmer the last twenty years. This function is used frequently in many other examples, so it is good to have around.

Function FindExcelCell(nColumn As Long, nRow As Long) As String
    Dim nPower1 As Long, nPower2 As Long
    nPower2 = 0
    If nColumn > 26 Then
        nPower2 = Int((nColumn - 1) / 26)
    End If
    nPower1 = nColumn - (26 * nPower2)
    If nPower2 > 0 Then
        FindExcelCell = Chr(64 + nPower2) & Chr(64 + nPower1) & nRow
    Else
        FindExcelCell = Chr(64 + nPower1) & nRow
    End If
End Function

Creating a pivot table

Teasing data out of a flat table and knitting it into a pivot table using VBA can be simplified immensely with this code. It finds the requested header in the Worksheet and, where the Header is not already present, it creates that Header.

The parameters are the Worksheet (as a Worksheet object) and the Header as a String. It returns the letter(s) of the column of that Header and automatically adjusts the widths of the Columns each time a new Header is added. This code relies on the FindExcelCell function above, so be sure to include that in the VBA of the spreadsheet along with this function.

Function GetColumn(objWorksheet As Worksheet, strHeader As String) As String
    'This function returns the letters of the column where header is located.  It creates the header if necessary.
    Dim nCurrentColumn As Long, strExcelCell As String
    For nCurrentColumn = 1 To 702  'ZZ
        strExcelCell = FindExcelCell(nCurrentColumn, 1)
        If objWorksheet.Range(strExcelCell).Value = strHeader Then
            GetColumn = Left(strExcelCell, Len(strExcelCell) - 1) 'Get the letters without the 1.
            Exit Function
        End If
        If objWorksheet.Range(strExcelCell).Value = "" Then
            'We hit the end of the columns.  Populate this header and return this column.
            objWorksheet.Range(strExcelCell).Value = strHeader
            objWorksheet.Range(strExcelCell).Font.Bold = True
            GetColumn = Left(strExcelCell, Len(strExcelCell) - 1) 'Get the letters without the 1.
            
            'Stretch the columns automatically to make the report easier to read.
            objWorksheet.Columns("B:" & GetColumn).AutoFit
    
            Exit Function
        End If
    Next
End Function

To call this function, include it with the Worksheet name and Header value in the Range function like this. The first line formats the cell as text.

                    Range(GetColumn(wsExtractSheet, strHeader) & nCurrent).NumberFormat = "@"  'Text.
                    Range(GetColumn(wsExtractSheet, strHeader) & nCurrent).Value = strValue

Bolding Column Headers and Freezing the Top Row

When creating a pivot table or any new Worksheet in Excel, a great value-add is to bold the headers and freeze the top row. This first snippet bolds the headers and gives them a subtle gray background.

    For iField = 1 To FIELDS.ROWCOUNT
        If iField < 27 Then
            strColumn = Chr(64 + iField)
        Else
            strColumn = Chr(64 + Int((iField - 1) / 26)) & Chr(64 + iField - (26 * (Int((iField - 1) / 26))))
        End If
        strCell = strColumn & "1"
        wsOutput.Range(strCell).Value = FIELDS(iField, "FIELDNAME")
        wsOutput.Range(strCell).Font.Bold = True
        wsOutput.Range(strCell).Interior.Color = RGB(222, 222, 222)
        retval = DoEvents()
    Next

This snippet freezes the top row so that the headers are always visible. It must be run when the target Worksheet is focused in the Excel Spreadsheet.

    'Freeze the top row...
    Application.ScreenUpdating = True
    ActiveWindow.FreezePanes = False
    ActiveWindow.SplitColumn = 0
    ActiveWindow.SplitRow = 1
    ActiveWindow.FreezePanes = True