Sitemap  · Français  · English  · Deutsch
Home » Blog » Article
Article

VBA Add-In for highlighting rows and columns in an Excel sheet

05.04.2010

For some time now, I'm evaluating my web server log files with Excel 2010. Yes, there are many other good tools for analyzing logfiles on the market and I'm also using some of them. However, Excel 2010 provides the function to easily import and filter the raw data of my logfiles. Unfortunately, with such amount of data, I'm often „loosing“ the line while reading on the screen. Ok, I can surely increase the zoom factor of the sheet or setup borders for the cells; my wish was, however, to have a tool which highlights the current line or column. As Excel does not provide such a feature, I decided to implement my own tool in VBA. The following screenshot shows the tool in action:

VBA Highlighter

The Add-In is available for free including the source code. At the end of this article, you will find the download link. In the following I will briefly present the Add-In and give some explanations about the code. Please note that I developped this tool for my own purposes; so I did not performed professional test series on different operations systems or with different Excel versions. The tool works fine on my Windows 7 system and runs in Excel 2003, 2007 and 2010 without problems. And please also note, that not all possible events may be triggered by the tool.

In a first step, I checked out which functions I would like to implement; the following features seemed to be useful:

Then I have created a prototype by creating a Userform and inserting some controls, as shown by the screenshot below:

VBA Highlighter

I used simple static text labels for the color bars and manually setted a background color for them. When initializing the Userform, following code is called:

  Private Sub UserForm_Initialize()
    
    Dim n As Long
    
'   Errors...
    
    On Error Resume Next
    
'   Api...
    
    mlfpApiMenueRemove Me.Caption, True, True
    
'   Create...
    
    Set mlvhHighlight = New MLC_Highlight
    
'   Parent...
    
    Set mlvhHighlight.Parent = Application
    
'   Bypass...
    
    mlvhBypass = True
    
'   Offsets...
    
    For n = 1 To 128
      
      CMB_Cols.AddItem CStr(n)
      CMB_Rows.AddItem CStr(n)
      
    Next n
    
'   Offsets...
    
    CMB_Cols.ListIndex = ThisWorkbook. _
    Worksheets(mlchSheet).Cells(6, 5).Value
    
    CMB_Rows.ListIndex = ThisWorkbook. _
    Worksheets(mlchSheet).Cells(7, 5).Value
    
'   Bypass...
    
    mlvhBypass = False
    
'   Color...
    
    Me.Controls("RDB_Color_" & CStr(ThisWorkbook. _
    Worksheets(mlchSheet).Cells(8, 5).Value)).Value = True
    
'   States...
    
    CHK_Rows.Enabled = True
    CHK_Cols.Enabled = True
    
    CMB_Cols.Enabled = False
    CMB_Rows.Enabled = False
    
    RDB_Color_1.Enabled = False
    RDB_Color_2.Enabled = False
    RDB_Color_3.Enabled = False
    RDB_Color_4.Enabled = False
    RDB_Color_5.Enabled = False
    
'   Focus...
    
    EDT_Focus.SetFocus
    
  End Sub

As you can see, the first function which is called is „mlfpApiMenueRemove()“. This function uses some Windows API functions to remove the close button on the upper right corner of the Userform at runtime. You can find this function in the „MLP_Api“ module. Then the variable „mlvhHighlight“ is instanciated; later more about this function. The Add-In stores some setting in a sheet which are read and assigned to the appropriate controls.

Ok, while developing the Add-In I asked myself, what can be the best method for highlighting the cells. One possibility is to set a background color or a border for the affected rows and columns. However, this will result in relatively complicated code, as I have to remember the previous state of the cells. A simplier is to use rectangular shapes for highlighting the columns and rows. Of course, this can only work, if the shapes are not filled with a background color.

Another goal I had, was to highlight the cells of the current active worksheet in the current active workbook. So, I needed to implement a class for triggering the Excel events on a global level, when selecting a workbook or a sheet.

The class „MLC_Highlight“ implements these functions. The class referenciates to an Application object and triggers the appropriate events, as you can see in the code excerpt below.

  Option Explicit
  
'
' Types...
'
' ........................................................................
  
' Type...
  
  Private Type mlthShape
    
    Handle     As Shape
    
    Book       As String
    Sheet      As String
    
    Color      As Long
    Offset     As Long
    Recreate   As Boolean
    
  End Type
  
'
' Vars...
'
' ........................................................................
  
' Application...
  
  Public WithEvents Parent                    As Application
  
' Array...
  
  Private mlvhShapes(1 To 2)                  As mlthShape
  
'
' Events...
'
' ........................................................................
  
' Class...
  
  Private Sub Class_Initialize()
    
    mlfhAction "Initialize"
    
  End Sub
  
  Private Sub Class_Terminate()
    
    mlfhAction "Terminate"
    
  End Sub
  
' Parent...
  
  Private Sub Parent_SheetActivate(ByVal Sh As Object)
    
    mlfhAction "Activate"
    
  End Sub
  
  Private Sub Parent_SheetDeactivate(ByVal Sh As Object)
    
    mlfhAction "Deactivate"
    
  End Sub
  
  Private Sub Parent_SheetSelectionChange(ByVal Sh As Object, _
                                          ByVal Target As Range)
    
    mlfhAction "Move"
    
  End Sub
  
  Private Sub Parent_WorkbookActivate(ByVal Wb As Workbook)
    
    mlfhAction "Activate"
    
  End Sub
  
  Private Sub Parent_WorkbookBeforeClose(ByVal Wb As Workbook, _
                                               Cancel As Boolean)
    
    mlfhAction "Deactivate"
    
  End Sub

  Private Sub Parent_WorkbookBeforeSave(ByVal Wb As Workbook, _
                                        ByVal SaveAsUI As Boolean, _
                                              Cancel As Boolean)
    
    mlfhAction "Deactivate"
    
  End Sub
  
  Private Sub Parent_WorkbookDeactivate(ByVal Wb As Workbook)
    
    mlfhAction "Deactivate"
    
  End Sub

The event handlers „Class_Initialize()“ and „Class_Terminate()“ are performing some tasks when the class is created and terminated. The other handlers are triggering some events; in the following how this should work:

The events handlers in the code above always call the „mlfhAction(…)“, which was just only created for a better overview in the code. Here the code for this function:

  Private Function mlfhAction(Action As String) As Long
    
    Dim n As Long
    
'   Bypass...
    
    On Error Resume Next
    
'   Select...
    
    Select Case Action
      
      Case "Activate"
        
'       Column...
        
        If mlvhShapes(mlcpMainShapeColumn).Recreate Then
            
          Create mlcpMainShapeColumn, _
                 mlvhShapes(mlcpMainShapeColumn).Offset, _
                 mlvhShapes(mlcpMainShapeColumn).Color
            
        End If
        
'       Row...
        
        If mlvhShapes(mlcpMainShapeRow).Recreate Then
          
          Create mlcpMainShapeRow, _
                 mlvhShapes(mlcpMainShapeRow).Offset, _
                 mlvhShapes(mlcpMainShapeRow).Color
            
        End If
        
      Case "Deactivate"
        
'       Delete...
        
        Delete mlcpMainShapeColumn, _
               mlvhShapes(mlcpMainShapeColumn).Recreate
        
        Delete mlcpMainShapeRow, _
               mlvhShapes(mlcpMainShapeRow).Recreate
        
      Case "Initialize"
      
'       Reset...
        
        Set mlvhShapes(mlcpMainShapeColumn).Handle = Nothing
        Set mlvhShapes(mlcpMainShapeRow).Handle = Nothing
        
'       Column...
        
        mlvhShapes(mlcpMainShapeColumn).Book = ""
        mlvhShapes(mlcpMainShapeColumn).Sheet = ""
        
        mlvhShapes(mlcpMainShapeColumn).Color = 0
        mlvhShapes(mlcpMainShapeColumn).Offset = 0
        mlvhShapes(mlcpMainShapeColumn).Recreate = False
        
'       Row...
        
        mlvhShapes(mlcpMainShapeRow).Book = ""
        mlvhShapes(mlcpMainShapeRow).Sheet = ""
        
        mlvhShapes(mlcpMainShapeRow).Color = 0
        mlvhShapes(mlcpMainShapeRow).Offset = 0
        mlvhShapes(mlcpMainShapeRow).Recreate = False
        
      Case "Move"
      
'       Move...
        
        Move mlcpMainShapeColumn
        Move mlcpMainShapeRow
        
      Case "Terminate"
      
'       Terminate...
        
        Delete mlcpMainShapeColumn, False
        Delete mlcpMainShapeRow, False
        
      Case Else
    
    End Select
    
'   Return...
    
    mlfhAction = 0
    
  End Function

As you can surley see, the function performs some actions, dependant from the value of the variable „Action“. For example, when activating an Excel sheet or workbook, a call to the „Create(…)“ function is made or in case the shapes should be deleted, a call to „Delete(…)“ is made. The two different types of rectangles (horizontal and vertical) are stored to the array „mlvhShapes()“. This array contains two elements of my user defined type mlthShape“. This type defines the variable „Recreate“, which is used for determining if the shape should be re-created. The type also contains more variables for the color, for the number of cells to highlight and for the names of the worksheet and the workbook. Let's now have a close look on „Create(…)“:

  Public Function Create(Item As Long, _
                         Offset As Long, _
                         Color As Long) As Long
    
    Dim h As Double
    Dim w As Double
    Dim x As Double
    Dim y As Double
    Dim r As Long
    
'   Bypass...
    
    On Error Resume Next
    
'   Update...
    
    mlvhShapes(Item).Book = Application.ActiveWorkbook.Name
    mlvhShapes(Item).Sheet = Application.ActiveSheet.Name
      
    mlvhShapes(Item).Color = Color
    mlvhShapes(Item).Offset = Offset
    mlvhShapes(Item).Recreate = True
    
'   Protection...
    
    If Application.ActiveSheet.ProtectDrawingObjects Then
      
'     Reset...
      
      Create = 1
      
'     Exit...
      
      Exit Function
    
    End If
    
'   Initialize...
    
    x = mlfhLeft(Item, Offset)
    y = mlfhTop(Item, Offset)
    
    h = mlfhHeight(Item, Offset, y)
    w = mlfhWidth(Item, Offset, x)
    
'   Create...
    
    Set mlvhShapes(Item).Handle = _
        Application.ActiveWorkbook.ActiveSheet. _
        Shapes.AddShape(msoShapeRectangle, x, y, w, h)
    
'   Check...
    
    If Not mlvhShapes(Item).Handle Is Nothing Then
      
'     Name...
      
      mlvhShapes(Item).Handle.Name = "Highlighter_" & CStr(Item)
      
'     Properties...
      
      mlvhShapes(Item).Handle.Fill.Visible = False
      mlvhShapes(Item).Handle.Line.Style = msoLineSingle
      mlvhShapes(Item).Handle.Line.ForeColor.RGB = Color
      mlvhShapes(Item).Handle.Line.Weight = 2
      
'     Result...
      
      r = 2
      
    End If
        
'   Return...
    
    Create = r
    
  End Function

In a first step, some parameters of one „mlvhShapes()“ item are filled. Then the code checks whether the targeted sheet is protected or not. If yes, the code exits, if not the code calculates the starting coordinates, the height and the width of the shape using the functions „mlfhLeft(…)“, „mlfhTop(…)“, „mlfhHeight(…)“ and „mlfhWidth(…)“. Finally some properties like the line weight or the transparency are set. Let's go the function calculating the width:

  Private Function mlfhWidth(Item As Long, _
                             Offset As Long, _
                             Left As Double) As Double
    
    Dim b As Boolean
    
    Dim n As Long
    Dim x As Long
    Dim y As Long
    
    Dim r As Double
    
'   Bypass...
    
    On Error Resume Next
    
'   Select...
    
    Select Case Item
      
      Case mlcpMainShapeRow
        
'       Initialize...
        
        n = 0
        x = Application.ActiveCell.Column
        y = Application.ActiveCell.Row
        
'       Loop...
          
        Do
          
'         Clear...
          
          Err.Clear
          
'         Increase...
          
          x = x + 1
          
'         Try...
          
          b = Application.ActiveWorkbook.ActiveSheet. _
              Columns(x).EntireColumn.Hidden
          
'         Check...
          
          If Err.Number <> 0 Then
            
'           Decreas...
            
            x = x - 1
            
'           Exit...
            
            Exit Do
            
          Else
          
'           Check...
            
            If Not b Then
              
              n = n + 1
              
            End If
            
          End If
          
        Loop While CBool(n < Offset)
        
'       Check...
        
        r = Application.ActiveWorkbook. _
            ActiveSheet.Cells(y, x).Left + _
            Application.ActiveWorkbook. _
            ActiveSheet.Cells(y, x).Width - Left
        
      Case Else
        
        r = Application.ActiveCell.Width
        
    End Select
    
'   Return...
    
    mlfhWidth = r
    
  End Function

The function checks for which type of rectangle (horizontal or vertical) the width should be calculated. This is very simple for the vertical shape; we just need to retrieve the width of the current cell. For the horizontal rectangle, we need to find the cell located „Offset“ columns away from the current cell on the right side. Please note, that I'm only counting the visible columns. If an error occures, then we know that the end of the sheet is reached and the loop is also exited.

Now, let's go to a very interesting part of the code: the function for deleting a shape.

  Public Function Delete(Item As Long, _
                         Recreate As Boolean) As Long
    
    Dim r As Long
    
'   Bypass...
    
    On Error Resume Next
    
'   Reset...
    
    r = 0
    
'   Check...
    
    If mlfhExists(Item) Then
      
'     Delete...
      
      Application.Workbooks(mlvhShapes(Item).Book). _
      Worksheets(mlvhShapes(Item).Sheet). _
      DrawingObjects(mlvhShapes(Item).Handle.Name).Delete
      
'     Clear...
      
      Set mlvhShapes(Item).Handle = Nothing
      
'     Reset...
      
      mlvhShapes(Item).Book = ""
      mlvhShapes(Item).Sheet = ""
      
'     Creation...
      
      mlvhShapes(Item).Recreate = Recreate
      
'     Result...
      
      r = 1
      
    Else
      
      r = 2
      
    End If
    
'   Return...
    
    Delete = r
    
  End Function

This function checks, if a rectangle was created and deletes it. This worked well in my most test cases. However, if I the active workbook contains a protected sheet and this sheet is active, it is not possible to delete a shape in a sheet from another workbook. The „Shape(…).Delete“ function does not work and throws an error. Fortunately the user „ransi“ in my favourite german office forum „Office-Lösung.de“ had a solution for this problem: just use the undocumented function „DrawingObjects(…).Delete“. This work well; thanks „ransi“.

Finally I had to implement the code in the Userform; in the following the code for the checkbox for activating or deactivating the highlighting for the rows:

  Private Sub CHK_Rows_Click()
    
    Dim b As Boolean
    Dim r As Long
    
'   Errors...
    
    On Error Resume Next
    
'   Bypass...
    
    If Not mlvhBypass Then
      
'     Check...
      
      If CBool(CHK_Rows.Value) Then
        
'       Create...
        
        r = mlvhHighlight.Create(mlcpMainShapeRow, _
            CMB_Rows.ListIndex + 1, mlvhColor)
        
'       Info...
        
        Select Case r
        
          Case 0
            
            EDT_Info.Text = "Error"
            
          Case 1
            
            EDT_Info.Text = "Protected"
            
          Case Else
            
            EDT_Info.Text = ""
            
        End Select
        
      Else
        
'       Delete...
        
        r = mlvhHighlight.Delete(mlcpMainShapeRow, False)
        
'       Info...
        
        Select Case r
          
          Case 0
            
            EDT_Info.Text = "Error"
            
          Case Else
            
            EDT_Info.Text = ""
            
        End Select
        
      End If
      
'     Get...
      
      b = CBool(CHK_Cols.Value) Or CBool(CHK_Rows.Value)
      
'     States...
      
      CMB_Cols.Enabled = b
      CMB_Rows.Enabled = b
      
      RDB_Color_1.Enabled = b
      RDB_Color_2.Enabled = b
      RDB_Color_3.Enabled = b
      RDB_Color_4.Enabled = b
      RDB_Color_5.Enabled = b
      
'     Focus...
      
      EDT_Focus.SetFocus
    
    End If
    
  End Sub

The shape is here also created by using the „Create(…)“ function when checking the checkbox and deleted by using the „Delete(…)“ function when unchecking the checkbox. The other controls are implemented in a similar manner.

The Add-In creates a new command bar in Excel 2003; in Excel 2007 and 2010, you should find a new entry on the Add-Ins Tab of the ribbon. And the Add-In saves itself when the main dialog is closed. You can download the Add-In by clicking on the following link::

» Excel Add-In for highlighting the row and columns in a sheet

Please note, that I can not give any support for the Add-In and I do not give any warranty of any kind for the Add-In. You use it at your own risk; of course you may close important documents before testing the Add-In on your computer. If you like to give me some feedback and suggestions or in case you find a bug, please write me. Last but not least, the link to the post from „ransi“.

This article has also been published in on my other blog Excel-Ticker.