SpyVsSpyLg

In January, I wrote a post that demonstrated how to combine Excel Workbooks. That post assumed that each of the source workbooks contained at least one ListObject Object.

Today, I will revise that code a bit to add a ListObject Object (LO) if the lo does not exist. Then I will demonstrate the code to merge Workbooks using Range Objects. Lastly, I will compare both processes to see which is the fastest using the Windows High Resolution Timer.


    edit: As is my usual practice, I am going to use Late Binding in the sample snippets below. A discussion on Late / Early Binding is beyond the scope of this post. Please see these links for a detailed explanation of Late / Early Binding.

    1. Beyond Excel
    2. JP Software Technologies


The ListObject Object (LO)

One of the very useful features the LO, is that it offers us the three distinct properties: HeaderRowRange, DataBodyRange, TotalsRowRange. Once we have a LO, we can leverage these properties to streamline the heavy lifting.

ListObjectRanges

Check If The ListObject Object Exists

I can check if the LO exists, if not, I can add one while I’m looping through workbooks:

Option Explicit

Sub AddListObjectIfDoesNotExist()

    'Does a  ListObject Object exist?
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lo As ListObject
    
    Set wb = ThisWorkbook
    For Each ws In wb.Worksheets
        Set lo = ws.Range("A1").ListObject
        If lo Is Nothing Then
            Set lo = ws.ListObjects.Add( _
                                    SourceType:=xlSrcRange, _
                                    Source:=ws.Range("A1").CurrentRegion, _
                                    Destination:=ws.Range("A1"))
        Else
            'ListObject already exists - do nothing
        End If
    Next ws
    
    'Tidy up
        Set lo = Nothing
        Set wb = Nothing
End Sub

Now that I can add an LO dynamically, I can exploit its properties with assurance.

Here is the fully revised code to merge Excel Workbooks using ListObject Objects:

Option Explicit
 
Sub MergeWorbooksUsingListObjects()
     
    'Log:
    'Date               Author                      Action                  Comment
    '-------------------------------------------------------------------------------------------------------------------
    '1/26/2014           ws                         Created                 Merge workbooks using ListObjects from source files
    '3/23/2014           ws                         Modified                If ListObject does not exist, add ListObject
    '-------------------------------------------------------------------------------------------------------------------
     
    'Delare variables
        Dim wb                  As Workbook
        Dim wbData              As Workbook
        Dim ws                  As Worksheet
        Dim wsData              As Worksheet
        Dim rngData             As Range
        Dim rngDestination      As Range
        Dim lo                  As ListObject
        Dim fso                 As Object
        Dim fsoFolder           As Object
        Dim fsoFile             As Object
        Dim strSelectedFolder   As String
        Dim strCurrentPath      As String
        Const strSpecifiedPath  As String = "C:\"
        Dim lngRows             As Long
        Dim blnFlag             As Boolean
         
    'Excel environment - speed things up
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
         
    'Initialize variables
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets("Data")
        blnFlag = True
         
    'Clear data from control workbook from previous consolidations
        ws.UsedRange.ClearContents
     
    'Get the current path, so reset the path at the end of the procedure
        strCurrentPath = CurDir()
         
    'Set the target directory to get the user closer to the working folder
    'This will minimize the time the user must spend drilling into the file system
    'once they are presented with the FileDialog
        ChDir (strSpecifiedPath)
     
    'Create a FileSystemObject
        Set fso = GetFSO
 
    'Prompt the user to select a folder
    'Return the path of the selected folder
        strSelectedFolder = GetSelectedFolder
         
    'Get the FSO Folder of the selected folder
        Set fsoFolder = fso.GetFolder(strSelectedFolder)
         
    'Loop each file in folder
    'Copy data from each file to control workbook
        For Each fsoFile In fsoFolder.Files
            Set wbData = Workbooks.Open(fsoFile)
            Set wsData = wbData.Worksheets("Sheet1")
             
            'Get next blank row from destination worksheet
            'If first time, need row 1, else, next blank row
                lngRows = GetRows(ws:=ws)
                If blnFlag = False Then lngRows = lngRows + 1
                 
            'The Destination Range
                Set rngDestination = ws.Cells(lngRows, 1)
             
            With wsData
                'If a ListObject does not exist, add a ListObject
                    Set lo = .Range("A1").ListObject
                    If lo Is Nothing Then
                        Set lo = .ListObjects.Add( _
                                              SourceType:=xlSrcRange, _
                                              Source:=.Range("A1").CurrentRegion, _
                                              Destination:=ws.Range("A1"))
                    Else
                        'Do nothing, ListObject already exists
                    End If
                
                'If first workbook, include the header row
                    For Each lo In .ListObjects
                        If blnFlag = True Then
                            Set rngData = Union(lo.HeaderRowRange, lo.DataBodyRange)
                            blnFlag = False
                        Else
                            Set rngData = lo.DataBodyRange
                        End If
                    Next lo
            End With
  
            'Copy the Data Range to the Destination Range
                rngData.Copy
                rngDestination.PasteSpecial xlPasteValuesAndNumberFormats
                 
            'Close the source file without saving
                wbData.Close
         
        Next fsoFile
         
    'Tidy up
        'Restore to original path
            ChDir (strCurrentPath)
             
        'Restore Excel environment
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
                .Calculation = xlCalculationAutomatic
            End With
             
        'Destroy objects
            Set fsoFolder = Nothing
            Set fso = Nothing
            Set lo = Nothing
            Set rngData = Nothing
            Set rngDestination = Nothing
            Set ws = Nothing
            Set wb = Nothing
         
End Sub

And the functions:


Public Function GetRows(ws As Worksheet) As Long
 
    Dim r       As Long
     
    With ws
        r = .Cells(Rows.Count, 1).End(xlUp).Row
        GetRows = r
    End With
     
End Function

'-------------------------------------------------------------------------
Public Function GetFSO()
 
    Dim fso             As Object
     
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set GetFSO = fso
     
    Set fso = Nothing
 
End Function

'-------------------------------------------------------------------------
Public Function GetSelectedFolder() As String
     
    Dim diaFolder       As FileDialog
    Dim strFolder       As String
 
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With diaFolder
        .AllowMultiSelect = False
        .Show
        strFolder = .SelectedItems(1)
    End With
 
    GetSelectedFolder = strFolder
End Function

Works great!

The Range Object

The Range Object does not have the properties: HeaderRowRange, DataBodyRange, TotalsRowRange. I am ok with the entire Range from the first Workbook when Merging multiple Workbooks. But on subsequent Workbooks, I want to exclude the header row.

Assume I have a Range named rng with address $A$1:$G$10, from this, I would like to exclude the header row on Row 1. The first step is to count the number of rows and columns in the range

Dim r As Long
dim c As Long
r = rng.Rows.Count
c = rng.Columns.Count

Next, from the rng, move down 1 Row. This means the rng address is now $A$2:$G$11

rng.Offset(1)

The $A$2 part of the address is good, but the $G$11 part means I now have a blank row. So now I need to Resize the rng to exclude the blank row:

rng.Offset(1).Resize(r-1,c)

And test the final Range Address to make sure all is as expected:

Debug.Print rng.Address

$A$2:$G$10

Perfect! Exactly what I was looking for. I’m now ready to modify the code again to use Range Objects instead of ListObject Objects.

Merge Workbooks Using Range Objects

Here’s the working code to merge workbooks using Range Objects instead of ListObject Objects:

Option Explicit
 
Sub MergeWorbooksUsingRangeObjects()
     
    'Log:
    'Date               Author                      Action                  Comment
    '-------------------------------------------------------------------------------------------------------------------------------------------
    '1/26/2014           ws                         Created                 Merge workbooks using ListObjects from source files
    '3/23/2014           ws                         Modified                If ListObject does not exist, add ListObject
    '3/23/2014           ws                         Modified                Use Range Object, modify range to exclude header row if not File = 1
    '-------------------------------------------------------------------------------------------------------------------------------------------
     
    'Delare variables
        Dim wb                  As Workbook
        Dim wbData              As Workbook
        Dim ws                  As Worksheet
        Dim wsData              As Worksheet
        Dim rngData             As Range
        Dim rngDestination      As Range
        Dim fso                 As Object
        Dim fsoFolder           As Object
        Dim fsoFile             As Object
        Dim strSelectedFolder   As String
        Dim strCurrentPath      As String
        Const strSpecifiedPath  As String = "C:\"
        Dim lngRows             As Long
        Dim r                   As Long
        Dim c                   As Long
        Dim blnFlag             As Boolean
         
    'Excel environment - speed things up
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
         
    'Initialize variables
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets("Data")
        blnFlag = True
         
    'Clear data from control workbook from previous consolidations
        ws.UsedRange.ClearContents
     
    'Get the current path, so reset the path at the end of the procedure
        strCurrentPath = CurDir()
         
    'Set the target directory to get the user closer to the working folder
    'This will minimize the time the user must spend drilling into the file system
    'once they are presented with the FileDialog
        ChDir (strSpecifiedPath)
     
    'Create a FileSystemObject
        Set fso = GetFSO
 
    'Prompt the user to select a folder
    'Return the path of the selected folder
        strSelectedFolder = GetSelectedFolder
         
    'Get the FSO Folder of the selected folder
        Set fsoFolder = fso.GetFolder(strSelectedFolder)
         
    'Loop each file in folder
    'Copy data from each file to control workbook
        For Each fsoFile In fsoFolder.Files
            Set wbData = Workbooks.Open(fsoFile)
            Set wsData = wbData.Worksheets("Sheet1")
             
            'Get next blank row from destination worksheet
            'If first time, need row 1, else, next blank row
                lngRows = GetRows(ws:=ws)
                If blnFlag = False Then lngRows = lngRows + 1
                 
            'The Destination Range
                Set rngDestination = ws.Cells(lngRows, 1)
             
            With wsData
                'Create the data range
                    Set rngData = .Range("A1").CurrentRegion
                    r = rngData.Rows.Count
                    c = rngData.Columns.Count
                
                'If first workbook, include the header row, otherwise resize the range to exclude the header row
                    If blnFlag = True Then
                        blnFlag = False
                    Else
                        Set rngData = rngData.Offset(1).Resize(r - 1, c)
                    End If
            End With
  
            'Copy the Data Range to the Destination Range
                rngData.Copy
                rngDestination.PasteSpecial xlPasteValuesAndNumberFormats
                 
            'Close the source file without saving
                wbData.Close
         
        Next fsoFile
         
    'Tidy up
        'Restore to original path
            ChDir (strCurrentPath)
             
        'Restore Excel environment
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
                .Calculation = xlCalculationAutomatic
            End With
             
        'Destroy objects
            Set fsoFolder = Nothing
            Set fso = Nothing
            Set rngData = Nothing
            Set rngDestination = Nothing
            Set ws = Nothing
            Set wb = Nothing
         
End Sub

That worked well, next I’ll add a little bit of code to time each of the Subs() to see if there is any appreciable difference.

Windows High-Resolution Timer (WHRT)

To use WHRT, I’ll just need to add 3 lines of code:

Declare a reference to the kernel32 library

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long

Get the tick count and assign it to a variable

t = GetTickCount

Get the tick count at the end, subtract the first to calculate elapsed time

debug.print GetTickCount - t & " Milliseconds"

I’ll put the Public Function “GetTickCount” in a Module with my other Public Functions.
I normally put the first call to the Public Function near the top of a Sub(), but in this case I’m using a FileDialog to interact with the user so I want to place the call to the Function after the FileDialog:

    'Prompt the user to select a folder
    'Return the path of the selected folder
        strSelectedFolder = GetSelectedFolder
        
    'Get the tick count
        t = GetTickCount

The last call to the GetTickCount Function goes at the very end of the code:

            Set ws = Nothing
            Set wb = Nothing
            
        'Get elapsed time
             Debug.Print GetTickCount - t & " Milliseconds"

The Results

The Sub() adding the ListObject Object dynamically:

1420 Milliseconds
1233 Milliseconds
1419 Milliseconds
1419 Milliseconds
1248 Milliseconds
1451 Milliseconds
1435 Milliseconds
1264 Milliseconds
1653 Milliseconds
1264 Milliseconds
——————–
1380.6 Milliseconds Avg

The Sub() Resizing the Range Object:

1217 Milliseconds
1217 Milliseconds
1451 Milliseconds
1264 Milliseconds
1232 Milliseconds
1232 Milliseconds
1248 Milliseconds
1263 Milliseconds
1264 Milliseconds
1248 Milliseconds
————————
1263.6 Milliseconds Avg

Tidy Up

    Final Thoughts

    The Sub() using the Range Object is a bit faster, but not much. Bear in mind, I ran the process on 3 files -each file with 50 rows and 7 columns. The results may be more pronounced on more files with more data in each file.

    Downloads

    Download the file containing both Subs() and all Functions here.

    Additional Resources

    ListObject Objects

    ListObject Object Model
    ListObjects Object Model
    Working with Tables in Excel 2013, 2010 and 2007 (VBA)
    Working with Microsoft Excel tables in VBA

    Range Object

    The Range Object – Object Model

, , ,

PTFlash4

In my last post, I showed how to hide the Field Captions of a Pivot Table by changing the font color to match the Interior ColorIndex of the Range. Shane replied on one of the LinkedIn Groups and recommended using the Custom Number Format, “;;;” instead. Let’s give it a try:

PTFieldCaptions1

Select the 3 cells that you want to remove the Captions. Click on the first cell, hold down the Ctrl key and click the other 2 cells:

PTSelectFieldCaptions

Click [Ctrl]+[1] on the keyboard to invoke the Format Cells Dialog.

FormatCellsDialog

Click on “Custom” in the Category Pane

FCD_CustomArrow

In the Type: InputBox, enter 3 semicolons, “;;;” and click, “OK”

FCD_CustomInputF

Field Captions are gone!!

FieldCaptionsManual

VBA

What we do manually, we should try to do with VBA. What if we have many PivotTables on many Worksheets? VBA to the rescue (Assume I restored the Captions so I don’t have to post another screen shot )

Sub PTHideFieldCaptionsCustomNumberFormat()

    'Declare variables
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim pt As PivotTable
        Dim rng As Range
        
    'Excel environment - speed things up
        Application.ScreenUpdating = False

    'Initialize variables
        Set wb = ThisWorkbook

    'Loop all PivotTables in all worksheets in the workbook
    'Set the Number Format of Field Captions so they will not display
        For Each ws In wb.Worksheets
            For Each pt In ws.PivotTables
                Set rng = pt.ColumnRange

                'Set the Number Format of the Field Captions to that nothing is displayed
                    Call SetRangeNumberFormat(rng:=rng)
    
            Next pt
        Next ws

    'Tidy up
        'Destroy objects
            Set rng = Nothing
            Set wb = Nothing

        'Restore Excel environment
            Application.ScreenUpdating = True

End Sub

'--------------------------------------------------------------------
Private Sub SetRangeNumberFormat(rng As Range)
                            
    Dim rngRow As Range
    Dim rngColumn As Range
    Dim rngBig As Range
    Const strNumberFormat As String = ";;;"

    Set rngRow = rng.Offset(1, -1).Resize(rng.Rows.Count - 1, 1)
    Set rngColumn = rng.Offset(0, -1).Resize(1, 2)
    Set rngBig = Union(rngRow, rngColumn)
    
    rngBig.NumberFormat = strNumberFormat
    
    Set rngBig = Nothing
    Set rngColumn = Nothing
    Set rngRow = Nothing

End Sub

FieldCaptionsVBA

Great tip, Shane – thanks!

Other PivotTable Posts At dataprose.org

  1. PivotTable Hide Field Captions – Change Font Color Option
  2. PivotTable Hide Field Captions
  3. PivotTable Conditional Formatting
  4. PivotTable Cell Borders

Additional Resources – PivotTables

  1. Contextures
  2. Peltier Technical Services, Inc.
  3. Chandoo

Additional Resources – Custom Number Formats

  1. A comprehensive guide to Number Formats in Excel – Jon von der Heyden
, ,

PivotTableFlash3

In my last PivotTable post, I showed how to hide PivotTable Field Captions. However, that hides the Filter Arrows as well.

PTNoFieldCaptions

What if you want to hide the Field Captions, but display the filter arrows?

PTArrowsNoLabels

I change the font color of the Field Captions to match the Range Interior ColorIndex

Sub PTFieldCaptionsChangeFontColor()

    'Declare variables
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim pt As PivotTable
        Dim pf As PivotField
        Dim rng As Range
        Dim lngRangeColor As Long

    'Excel environment - speed things up
        Application.ScreenUpdating = False

    'Initialize variables
        Set wb = ThisWorkbook

    'Loop all PivotTables in all worksheets in the workbook
    'Set Font Color of Field Captions to same color as Cell Interior ColorIndex
        For Each ws In wb.Worksheets
            For Each pt In ws.PivotTables
                
                'Get the interior fill color of the Column Range of the Pivot Table
                    Set rng = pt.ColumnRange
                    lngRangeColor = GetRangeColor(rng:=rng)
                    
                'Set the Font Color of the Field Captions to the same color as the Range Interior Color
                    Call ChangeFontColor(rng:=rng, _
                                         lngColor:=lngRangeColor)
    
            Next pt
        Next ws

    'Tidy up
        'Destroy objects
            Set rng = Nothing
            Set wb = Nothing

        'Restore Excel environment
            Application.ScreenUpdating = True

End Sub
'-----------------------------------------------------------------
Private Function GetRangeColor(rng As Range) As Long

    Dim lngColor As Long
    lngColor = rng.Interior.ColorIndex
    GetRangeColor = lngColor
    
End Function
'-----------------------------------------------------------------
Private Sub ChangeFontColor(rng As Range, _
                            lngColor As Long)
                            
    Dim rngRow As Range
    Dim rngColumn As Range
    Dim rngBig As Range

    Set rngRow = rng.Offset(1, -1).Resize(rng.Rows.Count - 1, 1)
    Set rngColumn = rng.Resize(rng.Rows.Count - 1, 1)
    Set rngBig = Union(rngRow, rngColumn)
    
    rngBig.Font.Color = lngColor
    
    Set rngBig = Nothing
    Set rngColumn = Nothing
    Set rngRow = Nothing

End Sub

PTFieldCaptionsInvisible

Other PivotTable Posts At dataprose.org

  1. PivotTable Hide Field Captions
  2. PivotTable Conditional Formatting
  3. PivotTable Cell Borders

Additional Resources

  1. Contextures
  2. Peltier Technical Services, Inc.
  3. Chandoo
, ,

PivotFlashRoman2

I don’t like PivotTable Field Captions

PTwFieldCaptions

You may turn them off manually:

  1. Click on a PivotTable
  2. The PivotTable Tools Tab is activated slightly above the Ribbon
  3. Click on the tab, “Analyze”
  4. In the PivotTable Group, click on the Options drop-down
  5. Click on options
  6. In the PivotTable Options Dialog, click on the Display tab
  7. Clear the tick mark on, “Display field captions and filter drop downs”

PTOptionsDialogFinal

But what if you have many PivotTables, or what if sometimes you want the Field Captions on and sometimes off? Let’s look at some VBA:

Option Explicit

Sub PTDisplayFieldCptions()

    'Declare variables
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim pt As PivotTable
    
    'Excel environment - speed things up
        Application.ScreenUpdating = False
        
    'Initialize variables
        Set wb = ThisWorkbook
        
    'Loop all PivotTables in all worksheets in the workbook
    'Turn off Field Captions
        For Each ws In wb.Worksheets
            For Each pt In ws.PivotTables
                pt.DisplayFieldCaptions = False
            Next pt
        Next ws
        
    'Tidy up
        'Destroy objects
            Set wb = Nothing
            
        'Restore Excel environment
            Application.ScreenUpdating = True
   
End Sub

Or, maybe you would like to toggle the display so if off, tune on and vice versa:

Option Explicit

Sub PTDisplayFieldCptionsToggle()

    'Declare variables
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim pt As PivotTable
    
    'Excel environment - speed things up
        Application.ScreenUpdating = False
        
    'Initialize variables
        Set wb = ThisWorkbook
        
    'Loop all PivotTables in all worksheets in the workbook
    'Turn off Field Captions
        For Each ws In wb.Worksheets
            For Each pt In ws.PivotTables
                If pt.DisplayFieldCaptions = False Then
                    pt.DisplayFieldCaptions = True
                Else
                    pt.DisplayFieldCaptions = False
                End If
            Next pt
        Next ws
        
    'Tidy up
        'Destroy objects
            Set wb = Nothing
            
        'Restore Excel environment
            Application.ScreenUpdating = True

End Sub

PTwFieldCaptionsOff

No more Field Captions

Other PivotTable Posts At dataprose.org

  1. PivotTable Conditional Formatting
  2. PivotTable Cell Borders

Additional Resources

  1. Contextures
  2. Peltier Technical Services, Inc.
  3. Chandoo
, ,

PivotFlashRoman1v2

I wanted to loop through a large workbook with lots of PivotTables to set a common conditional format on the DataBodyRange of each PivotTable.

Here’s my initial PivotTable with no conditional formatting:

PivotTableBigNCF

I would like change the text to red for any value that is less than 0.97 :

Option Explicit

Sub PTConditionalFormatting()

    'Declare variables
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim pt As PivotTable
        Dim rng As Range
        Dim dblLow As Double
        Dim dblHigh As Double
    
    'Excel environment - speed things up
        Application.ScreenUpdating = False
        
    'Initialize variables
        Set wb = ThisWorkbook
        dblLow = 0
        dblHigh = 0.97
        
    'Loop all PivotTables in all worksheets in the workbook
    'Set conditional formatting
        For Each ws In wb.Worksheets
            For Each pt In ws.PivotTables
                Set rng = pt.DataBodyRange
                Call FormatRange(rng:=rng, _
                                 dblValueHigh:=dblHigh, _
                                 dblValueLow:=dblLow)
            Next pt
        Next ws
        
    'Tidy up
        'Destroy objects
            Set wb = Nothing
            
        'Restore Excel environment
            Application.ScreenUpdating = True    
End Sub
'----------------------------------------------------------------------------
Private Sub FormatRange(rng As Range, _
                        dblValueHigh As Double, _
                        dblValueLow As Double)

    With rng
        .FormatConditions.Delete
        .FormatConditions.Add(Type:=xlCellValue, _
                              Operator:=xlBetween, _
                              Formula1:=dblValueHigh, _
                              Formula2:=dblValueLow).Font.Color = vbRed

    End With
End Sub

PTwCF

Very helpful if you have a lot of PivotTables to loop through. The Sub() takes a Range Object as one of the arguments. This means you could use it and pass it any Range Object – not just from PivotTables – Worksheet Range, ListObject Range, other PivotTable Range.

Additional PivotTable Resources

  1. Contextures
  2. Peltier Technical Services, Inc.
  3. Chandoo
, , ,

BeatlesLg
I like music – lots of different kinds of music, including The Beatles pictured here. These days, I’m more into “Adult Alternative” music, but I still like to listen to some stuff from the ’60’s and ’70’s every now and again.

Around these parts, we get “Breakfast With The Beatles” with Andre Gardner every Sunday from 7am-9am. Check your local listings to see if it is available in your area or you can stream it on KSLX. Really excellent show if you are into The Beatles.

However, today’s post is not about music or The Beatles. It is about Merging Excel Workbooks. Over on the LinkedIn Excel Groups there are many questions about merging data from several Excel Workbooks into 1 Workbook. Many folks suggest linking the workbooks using a formula. Others suggest using the INDIRECT() function. I prefer to use some VBA to copy the desired data from the Source Workbooks to the Destination Workbook.

All testing, screen shots, code in this post are from Office 365. If you are using another version of Excel, your results may vary (though they should not).

Linking Files

A common way to get data from one file to another is to link them. In this sample, I opened 2 Excel files, entered a value in 1 file, activated another file, typed, “=” and clicked on a cell in the 1st file:

LinkFiles2

DestinationWB.xlsx in the active workbook and cell $A$1 is selected. The formula bar give us:

  1. [SourceWB.xlsx] <- The name of the workbook
  2. Sheet1! <- The name of the worksheet
  3. $A$1 <- The cell reference

When I close the source workbook, the file path is added to the linked cell formula:

LinkedCellwPath

The folder location ‘C:\Data\ has been added to the linked formula.

There are a few things I do not like about linked cells

  1. The absolute references were added automatically. If I drag the formula to the right, the formula will still reference $A$1, not $B$1 as we may require
  2. What happens if a Row is added at Row 1 pushing all subsequent rows down by 1? This could cause an error in the linked formula, erroneous results, or at least the need for additional maintenance.
  3. What happens if the source file(s) are moved from the referenced folder location?

Here is the formula with the file in the folder ‘C:\OriginalFolder\.

PathReference

Linking Files – File Migration

One problem with linking files is that files move in our directory structures from time-to-time. We may initiate this move ourselves as we come up with a new way to organize our file structures. Other times this move may be initiated by the IT Department as they are updating or migrating storage.

Let’s see what happens to the original link formula when I move the source file.
I moved the file from ‘C:\OriginalFolder\ to ‘C:\NewFolder\ in Windows Explorer.

MoveFileFinal

Now when I try to update the link value in the Destination Workbook, I receive an error message

EditLinksErrorFinal

I can click on the change source button, but I would like a solution that provides for as little maintenance needs as possible.

Linking Files – Data Moves On Worksheet

The original linked formula is linked to cell A1 in the source file. What happens if, unbeknownst to you, a user inserts a blank row at A1 and all of the data shifts from A1 to A2?

UpdateValueFinal

The Edit Links Dialog status reads, “OK”, but it is not. The Linked Cell formula is still linked to Cell $A$1 and the updated Cell Value is now 0. We could use Find-Replace to update from $1 to $2, but that could have unintended consequences. What if other workbook moved data 2-3 rows? You see the point I’m sure.

Copy Data From Source To Destination

I propose to loop through a folder and copy some data from a worksheet for each workbook found in the folder – I would like the solution to be as dynamic as possible. As I am looping, I will paste the data on a worksheet in Top-Down fashion such that the first file results will be near the top, then the data from the second file and so on.

For today, my source files all have an Excel Table in them, though we could make the process work with Ranges as well with just a bit more work. For additional resources working with Excel Tables, see the links at the bottom of the post.

Some Functions & Properties

First, I’ll look at some VBA functions that I am going to use in the final code. These functions will make your code more dynamic and user-friendly.

CurDir

CurDir returns the current path. I use CurDir to trap the current path so I can restore it at then before I change the path to make navigating the file structure faster. Use as follows:

Option Explicit

Sub foo2()

    Dim strDirectory As String
    strDirectory = CurDir()
    Debug.Print strDirectory
    
End Sub

Output:

C:\Users\wsnyder\Documents

ChDir

ChDir changes the the current path. I use ChDir to change the current path to get the user closer the final folder they will eventually choose using the FileDialog to select a folder for processing. Use as follows:

Option Explicit

Sub foo2()

    Dim strDirectory As String
    strDirectory = "C:\Data\"
    ChDir (strDirectory)
    Debug.Print CurDir()
    
End Sub

Output:

C:\Data

FileDialog Property

The FileDialog Property of the Application Object returns a FileDialog Object. This give you the ability to interact with users at runtime by allowing the user to choose File(s) or Folder(s) to work with. The FileDialog accepts one argument, the DialogType.

There are 4 DialogTypes in the MsoFileDialogType Enumeration :

  1. msoFileDialogFilePicker
  2. msoFileDialogFolderPicker
  3. msoFileDialogOpen
  4. msoFileDialogSaveAs

For today’s purposes, I’ll use msoFileDialogFolderPicker

Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)

The Setup…

As I mentioned earlier, each source file has an Excel Table in it. I would like to loop through each file in the source folder and copy the DataBodyRange of the Excel Table to the destination workbook. Additionally, on the first pass, I would also like to copy the HeaderRowRange to create headers in the destination workbook. Lastly, I would like to add some data to the right of the data from the source files, such as the date the data was copied and the name of the source file.

Create Some Sample Data and Files

I quickly whipped up some sample data using Dick’s Random Data Generator and creatively saved the files as File1.xlsx, File2.xlsx, File3.xlsx.

TablesLayered

Again, I highlighted the data [Ctrl] + [a] and added an Excel Table [Ctrl] + [t] in each file. I applied a different Table Style to each Table simply to highlight the fact that there are 3 different Tables in 3 different Excel files. If you need to brush up on Excel Tables or need to start at the beginning:

  1. Excel Table Tutorial – Contextures
  2. Sur la Excel Table
  3. Listing Toward ListObjects

Loop Through Files In A Folder

When I need to loop through files in a folder – I use the FileSystemObject (FSO). The FileSystemObject is a top-level object in the Microsoft Scriping Runtime Library (Scrrun.dll). Here are some additional references if you need to brush up or are not familiar with FSO.

  1. JP Software Tech
  2. Chip Pearson
  3. 4 Guys From Rolla
  4. dataprose.org
  5. MSDN

edit: I am going to use Late Binding in the sample snippets below. A discussion on Late / Early Binding is beyond the scope of this post. Please see the “Additional Resources” at bottom for links to detailed explanation of Late / Early Binding.

Copying Data From Source To Destination

It’s finally time to copy the data from the source workbooks to the destination workbook. I’m using three files with 50 records each, but you could use this code with an unlimited number of records or variable number of records and unlimited number of files (3, 10, 50,…) – as long as you do not exceed 1,048,576 rows (though I would never use that many row in Excel – time to consider a database).

Option Explicit

Sub CopyDataFromSourceFiles()
    
    'Author         :           Winston Snyder
    'Created Date   :           1/26/2014
    'Comments       :           Assumes each source file contains at least one list object (Excel Table)
    
    'Delare variables
        Dim wb                  As Workbook
        Dim wbData              As Workbook
        Dim ws                  As Worksheet
        Dim wsData              As Worksheet
        Dim rngData             As Range
        Dim rngDestination      As Range
        Dim lo                  As ListObject
        Dim fso                 As Object
        Dim fsoFolder           As Object
        Dim fsoFile             As Object
        Dim strSelectedFolder   As String
        Dim strCurrentPath      As String
        Const strSpecifiedPath  As String = "C:\"
        Dim lngRows             As Long
        Dim blnFlag             As Boolean
        
    'Excel environment - speed things up
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
        
    'Initialize variables
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets("Data")
        blnFlag = True
        
    'Clear data from control workbook from previous consolidations
        ws.UsedRange.ClearContents
    
    'Get the current path, so reset the path at the end of the procedure
        strCurrentPath = CurDir()
        
    'Set the target directory to get the user closer to the working folder
    'This will minimize the time the user must spend drilling into the file system
    'once they are presented with the FileDialog
        ChDir (strSpecifiedPath)
    
    'Create a FileSystemObject
        Set fso = GetFSO

    'Prompt the user to select a folder
    'Return the path of the selected folder
        strSelectedFolder = GetSelectedFolder
        
    'Get the FSO Folder of the selected folder
        Set fsoFolder = fso.GetFolder(strSelectedFolder)
        
    'Loop each file in folder
    'Copy data from each file to control workbook
        For Each fsoFile In fsoFolder.Files
            Debug.Print fsoFile.Name
            Set wbData = Workbooks.Open(fsoFile)
            Set wsData = wbData.Worksheets("Sheet1")
            
            'Get next blank row from destination worksheet
            'If first time, need row 1, else, next blank row
                lngRows = GetRows(ws:=ws)
                If blnFlag = False Then lngRows = lngRows + 1
                
            'The Destination Range
                Set rngDestination = ws.Cells(lngRows, 1)
            
            'If first time, include the header row
                With wsData
                    For Each lo In .ListObjects
                        If blnFlag = True Then
                            Set rngData = Union(lo.HeaderRowRange, lo.DataBodyRange)
                            blnFlag = False
                        Else
                            Set rngData = lo.DataBodyRange
                        End If
                    Next lo
                End With
                
            'Copy the Data Range to the Destination Range
                rngData.Copy
                rngDestination.PasteSpecial xlPasteValuesAndNumberFormats
                
            'Close the source file
                wbData.Close
        
        Next fsoFile
        
    'Tidy up
        'Restore to original path
            ChDir (strCurrentPath)
            
        'Restore Excel environment
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
                .Calculation = xlCalculationAutomatic
            End With
            
        'Destroy objects
            Set fsoFolder = Nothing
            Set fso = Nothing
            Set rngData = Nothing
            Set rngDestination = Nothing
            Set ws = Nothing
            Set wb = Nothing
        
End Sub
'------------------------------------------------------------------------------------
Private Function GetRows(ws As Worksheet) As Long

    Dim r       As Long
    
    With ws
        r = .Cells(Rows.Count, 1).End(xlUp).Row
        GetRows = r
    End With
    
End Function
'------------------------------------------------------------------------------------
Private Function GetFSO()

    Dim fso             As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set GetFSO = fso
    
    Set fso = Nothing

End Function
'-------------------------------------------------------------------------------
Private Function GetSelectedFolder() As String
    
    Dim diaFolder       As FileDialog
    Dim strFolder       As String

    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With diaFolder
        .AllowMultiSelect = False
        .Show
        strFolder = .SelectedItems(1)
    End With

    GetSelectedFolder = strFolder
End Function

MergeSourceFiles

I formatted the output and hid some rows to show that there are 151 records as expected (3 files * 50 records each + 1 header row).

My favorite part of the code is here

'If first time, include the header row
                With wsData
                    For Each lo In .ListObjects
                        If blnFlag = True Then
                            Set rngData = Union(lo.HeaderRowRange, lo.DataBodyRange)
                            blnFlag = False
                        Else
                            Set rngData = lo.DataBodyRange
                        End If
                    Next lo
                End With

The properties of the ListObject (Excel Table) such as HeaderRowRange and DataBodyRange are 2 reasons why the ListObject is far superior to the Range Object. Couple these kinds of properties with the fact that you can move the Excel Table anywhere on the worksheet you want and add rows to the Table or redact rows from the Table and the consolidation code will still work flawlessly. No Excel Hell! Awesome!

Tidy Up

, , , , , , ,

BorderCollie
I’m a dog person. I have a Yellow Lab, but I’ve always wanted a Border Collie. They are amazing “workhorse”, acrobatic and athletic dogs. Maybe someday I’ll have some land and animals so a Border Collie will be more fitting.

In the meantime, today’s post is not about dogs and farm animals – its about Excel PivotTables.

I like Pivot Tables a lot! I always try to use Pivot Tables before another other solution, if possible, for reporting purposes. But Pivot Table formatting options may not cover the entire spectrum of how we would like to format our Pivots.
PT1_Med
For example, I would like to add cell borders to all Data Range and Row Label items, but not Headers and GrandTotals.
PT_wBorderNotes2
I tried some different PivotTable Styles, but none gave me exactly what I was looking for. In this screen shot, for example, I tried adding adding a border to first column.

ColumnStripe1

There are 2 problems with this:

  1. The Header Row and the Grand Total Row also have the Column Border applied
  2. There does not appear to be a way to apply the same format across all columns

Enter PivotTable Ranges and VBA

Excel PivotTables offer various Ranges within the PivotTable. Jon Peltier covers the various Ranges here, so I won’t recover the information. Make sure you check out Jon’s tutorial – excellent!

DataBodyRange

I colored the DataBodyRange in the PivotTable below with a little VBA
DataBodyRangeFinal

Sub HighlightDataBodyRange()
    'Color the DataBodyRange of a PivotTable

    Dim wb         As Workbook
    Dim ws         As Worksheet
    Dim pt         As PivotTable
    Dim rng        As Range
    Dim lngGrey    As Long
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    lngGrey = RGB(217, 217, 217)
    
    With ws
        For Each pt In ws.PivotTables
            Set rng = pt.DataBodyRange
            rng.Interior.Color = lngGrey
        Next pt
    End With
    
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
    
End Sub

Looks pretty good, except:

  1. The DataBodyRange includes the Grand Total Row
  2. The DataBodyRange does not include the Row Labels

RowRange

I colored the RowRange in the PivotTable below with a little VBA
RowRangeFinal

Sub HighlightRowRange()
    'Color the RowRange of a PivotTable

    Dim wb          As Workbook
    Dim ws          As Worksheet
    Dim pt          As PivotTable
    Dim rng         As Range
    Dim lngGrey     As Long
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    lngGrey = RGB(217, 217, 217)
    
    With ws
        For Each pt In ws.PivotTables
            Set rng = pt.RowRange
            rng.Interior.Color = lngGrey
        Next pt
    End With
    
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
    
End Sub

Looks pretty good, except:

  1. The RowRange includes the Grand Total Row
  2. The RowRange includes the Header Row
  3. The RowRange does not include the DataBodyRange identified previously

I have an understanding of a couple of ranges and their shapes. Now I need to reshape the ranges and merge them together.

Resize A Range

RangeReshape

The heavy dashed line in the screen shot shows what the final shape of each range should be if the VBA code works correctly. I filled the resized Ranges with new colors to show that they have been properly resized.

RangesResizedColored

Here’s the Function I came up with for resizing the Ranges. I don’t like it very much, but it works. I think there should be an enumeration for the Range Types of the Excel PivotTable. Maybe there is and I’m not aware of it.

Private Function GetResizedRange(rng As Range, _
                                 strType As String) As Range

    Dim r           As Long
    Dim c           As Long
    
    With rng
        r = .Rows.Count
        c = .Columns.Count
    End With
    
    Select Case strType
        Case "RowRange"
           Set rng = rng.Offset(1).Resize(r - 2, c)
        Case "DataBodyRange"
            Set rng = rng.Resize(r - 1, c)
    End Select
    
    Set GetResizedRange = rng
    Set rng = Nothing

End Function

Borders

FinalCellBorders
The cell borders look great and the original stated objectives have been achieved. I added the cell borders with this sub:

Private Sub AddBorders(rng As Range)

    Dim lngGrey          As Long
    lngGrey = RGB(217, 217, 217)
    
    With rng.Borders
        .LineStyle = xlContinuous
        .Color = lngGrey
    End With

End Sub

The Complete Code

Here’s the complete code so you can copy pate it in one swoop if you so desire:

Option Explicit
Sub AddCellBordersToPivot()
    'Color the DataBodyRange of a PivotTable

    Dim wb              As Workbook
    Dim ws              As Worksheet
    Dim pt              As PivotTable
    Dim rngType         As Range
    Dim rngRow          As Range
    Dim rngData         As Range
    Dim strRangeType    As String
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    
    With ws
        For Each pt In ws.PivotTables
            'RowRange
                Set rngType = pt.RowRange
                strRangeType = "RowRange"
                Set rngRow = GetResizedRange(rng:=rngType, _
                                             strType:=strRangeType)
                
            'DataBodyRange
                Set rngType = pt.DataBodyRange
                strRangeType = "DataBodyRange"
                Set rngData = GetResizedRange(rng:=rngType, _
                                              strType:=strRangeType)
                                             
            'Add borders
                Call AddBorders(rng:=rngRow)
                Call AddBorders(rng:=rngData)
                
        Next pt
    End With
    
    Set rngType = Nothing
    Set rngRow = Nothing
    Set rngData = Nothing
    Set ws = Nothing
    Set wb = Nothing
    
End Sub

Private Sub AddBorders(rng As Range)

    Dim lngGrey          As Long
    lngGrey = RGB(217, 217, 217)
    
    With rng.Borders
        .LineStyle = xlContinuous
        .Color = lngGrey
    End With

End Sub

Private Function GetResizedRange(rng As Range, _
                                 strType As String) As Range

    Dim r           As Long
    Dim c           As Long
    
    With rng
        r = .Rows.Count
        c = .Columns.Count
    End With
    
    Select Case strType
        Case "RowRange"
           Set rng = rng.Offset(1).Resize(r - 2, c)
        Case "DataBodyRange"
            Set rng = rng.Resize(r - 1, c)
    End Select
    
    Set GetResizedRange = rng
    Set rng = Nothing

End Function

Tidy Up

    Final Thoughts

    That’s it for today. I’m a little surprised there is not an easier way to refer to the Ranges I had to reshape here. I think users would like to apply formats separate from Header Rows and Grand Total Rows. How do you handle these issues? Do you know of a way to achieve this formatting using PivotTable Styles that I was not able to find? Where’d I put the dog’s leash? Time for a walk.

    Downloads

    Download the file from SkyDrive. The file name is PivotTable_CellBorders.xlsm

, ,


boatlisting

My grasp of all things maritime is limited:

  1. I love seafood (Scallops with garlic, butter and white wine – I’m looking at you)
  2. I can still tie a few knots I learned in Scouts
  3. I enjoy The Pirates of the Caribbean Ride at Disney World
  4. I can speak like a pirate. (International Speak Like a Pirate Day is Friday, September 19, 2014. So set yer reminder on yer calendar on yer mobile device now matey, arrrrgghhh!)

Today’s post, however, is not about my favorite ale or the Jolly Roger. It is about the ListObjects Object and / or ListObject Object of the Excel Object Model. There is no typo there – though admittedly it does look and sound a little odd. Links to the Object Models are at the bottom of this post.

Convert a ListObject To A Range

I’ll begin by converting an Excel Table (ListObject) that I created in my last post back to a Range. Warning: Converting an Excel Table to a Range will wreak havoc on any Structured Reference formulas that are using the Excel Table Do not try this on any production models, use test workbooks only until you have a full understanding on the outcomes.

Unlist The Excel Table

Option Explicit

Sub ConvertListObjectToRange_1()
    'Purpose:   Unlist an Excel Table to convert it to a range

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lo As ListObject
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Data")
    
    For Each lo In ws.ListObjects
        lo.Unlist
    Next lo
    
    Set ws = Nothing
    Set wb = Nothing

End Sub

Unlist1

  1. The filter arrows are gone
  2. When I click on a cell within the Range, the Table Tools Tab no longer activates

The Excel Table has been converted to a Range. But I would also like to remove all formatting that was introduced by the Excel Table.

Remove Formatting Left By Excel Table

I would like to remove the these formats:

  1. Remove all color
  2. Remove all borders
  3. Make sure all font colors are black
  4. Make sure all fonts are normal (not bold)
Sub RemoveFormatting()
    'Purpose:   Remove formatting left from Excel Table

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Data")
    Set rng = ws.Range("A1").CurrentRegion
    
    With rng
        .Interior.ColorIndex = xlColorIndexNone
        .Borders.LineStyle = xlLineStyleNone
    End With
    
    With ws
        .Range("A1").EntireRow.Font.Color = vbBlack
        .Range("A1").EntireRow.Font.Bold = False
    End With
    
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

Table2RangeFrmat
Looks good – all cleaned up! Next, I’ll look at adding a ListObject (Excel Table) using VBA

A Quick Segue – Table Styles

In my code for adding the Excel Table, I will want to add a Table Style so let’s look at some code to list available styles:

Sub ListTableStyles()
    
    'Purpose:   List all Table Styles in the workbook
    'Comment:   [Ctrl] + [G] to activate the immediate window to view the output

    Dim wb As Workbook
    Dim ts As TableStyle
    
    Set wb = ActiveWorkbook
    
    With wb
        For Each ts In .TableStyles
            Debug.Print ts.Name
        Next ts
    End With
    
    Set wb = Nothing
    
End Sub

TableStyleList
Now I have a list of all available styles in the workbook as well as the correct naming convention to be used.

Convert A Range To A ListObject (Excel Table)

Now I am ready to convert the Range back to a ListObject (Excel Table)

Sub ConvertRangeToTable()
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim lo As ListObject
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Data")
    Set rng = ws.Range("A1").CurrentRegion

    Set lo = ws.ListObjects.Add(SourceType:=xlSrcRange, _
                                Source:=rng, _
                                TableStyleName:="TableStyleMedium4", _
                                Destination:=Range("A1"))
    lo.Name = "tblData"
                                
    Set lo = Nothing
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
                                       
End Sub

RangeToTable
Looks great! I now have an Excel Table named, “tblData”. There are additional Source Types that may be used as a source for the Excel Table: Source Type Enumeration. I will look at these in future posts.

ListObject Business Case

A fairly common request over on the LinkedIn Excel Groups is how to copy filtered data without the header row to another Worksheet or Range. This can be accomplished with a Range Object and a few manipulations to shape the data. But it is much easier with ListObjects.
The ListObject offers three distinct Ranges that may be exploited in VBA:

The HeaderRowRange

HeaderRowRange2

The DataBodyRange

DataBodyRange

The TotalsRowRange

TotalsRowRange
For today, I will focus on the DataBodyRange. I want to filter the data and copy the Rows that remain except for the HeaderRowRange.

Sub FilterTable()
    'Purpose:   Filter Excel Table, copy visibile range

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim lo As ListObject
    Const strCriteria As String = "Aetna"
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Data")
    Set rngDestination = ws.Range("G3")
    
    With ws
        For Each lo In .ListObjects
            'DataBodyRange to Range
                Set rng = lo.DataBodyRange
            
            'Filter the Range
                rng.AutoFilter _
                    Field:=1, _
                    Criteria1:=strCriteria
                    
            'Copy the visible range
                rng.SpecialCells(xlCellTypeVisible).Copy
                rngDestination.PasteSpecial xlPasteValuesAndNumberFormats
        Next lo
    End With

    Set rngDestination = Nothing
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

FilterData
Looks great! Quite a bit easier than jumping through some gyrations to reshape the data to remove the header row from the visible range.

I use the SpecialCells Method of the Range Object here to copy just the visible range. I covered this previously in ,this post

Tidy Up

    Final Thoughts

    That’s it for today. I hope you find this post helpful and are able to go through fewer gyrations in the future to shape your data. Now, where’d I put my parrot and wooden leg?

    Downloads

    Download the file from Skydrive

, , , ,

FineDiningLG

Generally, I’m an easy-going guy – very content with a good burger and a good brew. Every now and again, however, it’s fun to put on my fines and kick up my heels.

I’ve worked as a controller (spreadsheet jockey) for a few food service companies, so I have been around and pitched in on more than a few catering events. I’m here to tell you, it’s tough work, with excruciatingly long hours on your feet. I’m used to shining a seat, not being on my feet for 10-12 hours at a clip.

So, next time you’re at a great event, make sure you let the folks doing the heavy lifting that you appreciate their hard work so that you can have a good time.

Today’s post, however, is not about extraordinary events and culinary creations. This post is about Excel Tables – an underused feature in Excel. Over on the LinkedIn Excel Groups, Craig Hatmaker is leading the charge to make more folks aware of Excel Tables and their advantages. I’m curious as why more folks do not use Excel Tables? I look forward to any all comments below as to why this may be.

Create An Excel Table

You may Get External Data from Access, SharePoint, etc… and the resulting data in Excel will be presented in an Excel Table automatically. For now, I will simply create an Excel Table from a Range. However, in production these days, I keep all data external from Excel in Access, SharePoint or SQL Database.

I cooked up some data using a Random Data Generator from Dick Kusleika over at Daily Dose of Excel. I added some formatting to make it more palatable on a web browser. Now I want to convert the Range into an Excel Table.

RangeForTable

I clicked on any cell in the Range, clicked on the Insert Tab on the Ribbon and clicked on the Table icon in the Tables Group as indicated by the arrow in the screen shot. If you are a keyboard person, you may press [Ctrl] + [T] to activate the Create Table Dialog.

TableInsertComment

The continuous range is automatically selected as indicated by the “dancing ants”. The Create Table Dialog opens. The Range Selection Tool displays the selected range while also allowing you to use the selector tool to select your own range should you choose to do so. The “My table has headers” checkbox is ticked automatically.

CreateTableDia

Click “Ok” when you are finished and your Range is converted into an Excel Table. The default Table Style is applied to the table

Table3

Ribbon – Design Tab : Table Tools

When you click on an Excel Table, the Design Tab : Table Tools becomes active on the Ribbon. The Design Tab : Table Tools gives you many tools for working with properties styles and options of the Excel Table. The tab disappears when you are not clicked on a cell in the Excel Table.

TableTools1

TableTools2

Excel Table – Name

Please note in the first screen shot of the Ribbon, in the Properties Group, the name of the Excel Table is Table2. You may change this and I recommend you do to something more meaningful. For demonstration purposes, I’ll name this Excel Table -> tblRevenues.

Structured References – Calculated Columns

Let’s take a look at adding a calculation to the Excel Table. Suppose we want to know what happens to Total Revenue if we increase it by 10 %. I move to the next available column, and enter a description in the header row

CalcColumn1

Look at what happens when I confirm the description in the header row by pressing enter. The Table Style formatting is automatically filled down the new column.

CalcColumn2

Now I need to enter a formula to increase the Total Revenue of each row by 10 %. In cell E2, I enter = and click on D2, Excel enters the Column Specifier, “[@TotalRevenue]” for me.

CalcColumn6

I complete the formula by multiplying by 1.1, pressing enter, and then using the fill handle in the lower right corner of the cell to send the formula down.

CalcColumn4

Look Ma’ – No Dynamic Ranges

One of the most frequent errors we read about is data being missed by a formula using by a cell reference formula: =SUM(Sheet1!$A$2:$A$10)

One way around this is to use Dynamic Named Ranges (DNR). Daniel Ferry shows us how to create DNR’s using the INDEX() function in his epic post, The Imposing Index. Definitely check it out.

But with Excel Tables, we do not need to create Dynamic Named Ranges. As we add data to the Excel Table it is added to the table and included in any analyses of the data.

Structured Reference – Analytical Example

Let’s suppose we are interested in a summary total based on a few criteria such as company name, account number and date range. We can use the SUMIFS() function with our Excel Table and Structured references instead of cell references:

=SUMIFS(tblData[Amount],tblData[Company],"="&A2,tblData[Account],"="&B2,tblData[Date],">="&C2,tblData[Date],"<="&D2)

SummaryAmount

What happens if I add 1 more record that meets all of the criteria for $1,000? Wblanke expect the new total to be $10,562.36.

CalcColumn7

SummaryAmount2

Perfect! $10,562.36 as expected.

Does The Formula Make Your Eyeballs Spin?

Let’s take another look.

=SUMIFS(tblData[Amount],tblData[Company],"="&A2,tblData[Account],"="&B2,tblData[Date],">="&C2,tblData[Date],"<="&D2)

Kris Szabo once commented on one of the LinkedIn Groups that the formula made her eyeballs spin. Fair enough – Let’s try wrapping the formula to see if that makes it easier to read.

  • Click on the cell with the formula so that the formula is visible in the formula bar
  • Move the cursor to the beginning of each occurrence of the table name, “tblData”
  • Press [Alt] + [Enter] on the keyboard to force all subsequent text to the next line
  • Press [Spacebar] to move the text until it is in the correct column

When complete, this is what the formula should look like in the formula bar

=SUMIFS(
        tblData[Amount],
        tblData[Company],"="&A2,
        tblData[Account],"="&B2,
        tblData[Date],">="&C2,
        tblData[Date],"<="&D2
       )

Much easier to read – what do you think?

The Peter Principle – Update Sept. 6, 2014

Over on the ExcelHero Group on LinkedIn, Peter Bartholomew correctly pointed out that we may use a 2nd Excel Table and then refer to the variable components through the use of the Table Object Nomenclature instead of using the cell references as I did above.

The revised formula using the Table Object Nomenclature:

= SUMIFS( tblData[Amount], 
          tblData[Company], "=" & [@Company], 
          tblData[Account], "=" & [@Account], 
          tblData[Date], ">=" & [@StartDate], 
          tblData[Date], "<=" & [@EndDate] 
        ) 

My take:

I like the 2 Table approach. However, the horizontal (ColumnWise) layout does not feel natural. Many, perhaps most, user-input forms are designed with a vertical (RowWise) layout.

Additionally, in some reporting situations, we may want to refer to the same criteria without repeating the criteria (Some folks find the repetition “ugly” or at least “irritating”). For example we may want to hold constant “Company” and “Account” through the use of Absolute References while varying the Start and End dates to examine account balances through the periods of the fiscal year or some span of time.

Is This A Segue To DAX?

DAX is Dynamic Analysis eXpressions. It is the formula language behind Data Models with Power Pivot as well as a query language for working with Tabular Databases. Here is a very simple DAX Formula that I borrowed from Chandoo’s site: SUM(sales[sale amount]). Looks a lot like the syntax for Structured References – doesn’t it? I’m not saying that if you know Excel Tables w/ Structured References that you will know everything there is to know about DAX. I’m simply saying that if you can work with Excel Tables w/ Structured References, it will help you understand DAX a bit more.

Next Up – VBA for Excel Tables (ListObjects)

I covered Excel Tables here as a precursor to looking into the ListObject Object Model in VBA. The ListObject is parlance in VBA for Excel Tables – I suspect a holdover from Lists the original name for Excel Tables when they were first introduced in Excel 2003. Have a look at the Members (Properties and Methods) of the ListObject Object Model and stay tuned for my next post on ListObjects.

Tidy Up

    Final Thoughts

    That’s it for now. I really like Excel Tables and I think you will like them even more once I show some VBA code for ListObjects. Remember, Excel Tables and ListObjects are the same thing.

    There are several nice features about Excel Tables, but for me the best part is automatically adding data to the table so that all data is included in any analyses. What do you like most?

, , ,


MrClean

Mr. Clean swept his way into American homes in 1958 after Proctor and Gamble bought the rights from its creator, Linwood Burton. Interestingly, Regular Expressions were first described in the 50’s by Stephen Cole Kleene. Coincidence? I think not.

However, today’s post is not about household cleaning products, nor is it a history lesson in Computer Science. It is about scrubbing data in VBA using Regular Expressions (RegExp).

Substitute ()

I see many folks using multiple nested levels of the Substitute() function to try to clean their data. This can be time consuming and can lead to some inaccuracies. Instead, we can use Regular Expressions (RegExp) to increase efficiency and accuracy as well as handle complex strings and large data sets quickly and efficiently.

User Defined Functions

I also see folks create User Defined Functions (UDF’s) to manipulate strings. Here is a nice example the other day from Doug Jenkins over at Newton Excel Bach. (btw, If you are not following Doug’s blog, you should be) But is there a better way? Enter Regular Expressions (RegExp).

Regular Expressions (RegExp)

A Regular Expression is a sequence of characters that create a pattern. The sequence could be something complicated like <([A-Z][A-Z0-9]*)\b[^>]*>(.*?) to something simple like \d . Regular Expressions are very useful in VBA for working with many different scenarios of strings and introducing automation for transforming your data before loading to target databases for OLAP such as Essbase, Power Pivot or SSAS.

Regular Expression – Methods

Regular Expressions in VBA offers 3 Methods:

  1. Test
  2. Replace
  3. Execute

For today, I will focus on the Execute Method and look at the other Methods in future posts.

An example

Here’s a silly nonsensical string, 12kj$%23fg^&*34950…345. Let’s say I’m only interested in the numbers in the string so I want to return 122334950345. To return just the numbers from the string, I’ll use the pattern [0-9].

Option Explicit

Sub RegExFoo()
    
    'Author: Winston Snyder
    'Date: 12/11/2013
    'Extract a pattern of interest from an input string

    'Declare variables
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim RE As Object
        Dim Match As Object
        Dim Matches As Object
        Dim strNumber As String
        Dim i As Long
    
    'Initialize variables
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets("Sheet1")
        Set RE = CreateObject("VBScript.RegExp")
    
    'Criteria for Regular Expression
        With RE
            .Pattern = "[0-9]"
            .Global = True
            Set Matches = .Execute(ws.Range("A1").Value)
        End With
        
    'Loop Matches collection to build string of all numbers in the sample string
        strNumber = ""
        For i = 0 To Matches.Count - 1
            strNumber = strNumber + Matches(i)
        Next i
        
    'Output
        MsgBox strNumber
    
    'Tidy up
        'Destroy objects
            Set Matches = Nothing
            Set RE = Nothing
            Set ws = Nothing
            Set wb = Nothing
    
End Sub

Output : 122334950345

Great! The code returned exactly what I was looking for.

Case Study: RegExp

The sample is a bit obscure and seems somewhat unlikely, but who knows – might be just the thing someone is looking for. Let’s take a look as something a bit more realistic.

Let’s say we receive a load file from Financial Analysis and Planning (FP&A) that they would like loaded to a cube as a forecast scenario. For our sample, we’ll use Customer Codes and Total Revenues. We receive the file, but we immediately see that there is a problem.

DataRegEx3

There is no delimiter between the customer code and the total revenue amount. Additionally, both sets of substrings are of varying length meaning we cannot use text to columns without some manual cleanup work. Let’s look at one way we might split these strings using Regular Expressions.

I’m going to:

  1. Read the strings into an array
  2. Loop the array
  3. Split the string into substrings – load the substrings into new arrays
  4. Output the contents of the new arrays to a worksheet

A Quick Note – Early / Late Binding

A discourse on Early / Late Binding is beyond the scope of this post. Suffice to say, I am using Late Binding as demonstrated:

 Dim RegEx                               As Object
'Create a regular epression object
        Set RegEx = GetRegEx
Private Function GetRegEx() As Object

    On Error Resume Next
    Set GetRegEx = CreateObject("VBScript.RegExp")
    
End Function

There are additional links at the bottom of the post for more information on Early / Late Binding.

The Complete Code

You can open a new workbook, launch the Visual Basic Editor (VBE) add a new module and paste the code below into the module. I broke the Subs() and Functions() into separate snippets to improve readability. Alternatively, you can download the workbook, the link is at the bottom of the post.

 Option Explicit
 Sub SplitStringNoDelimiter()
    
    'Author:        Winston Snyder
    'Date:          12/15/2013
    'Purpose:       Split string into text and value components
    'Comments:      No delimiter
    '               Loop array for output
    '---------------------------------------------------------------------------------------------------------------------------------------------
    
    Dim RegEx                               As Object
    Dim wb                                  As Workbook
    Dim wsInput                             As Worksheet
    Dim wsOutput                            As Worksheet
    
    Dim rngInput                            As Range
    Dim rngOutputDescriptions               As Range
    Dim rngOutputValues                     As Range
    
    Dim arrInput()                          As Variant
    Dim arrOutputDescriptions()             As Variant
    Dim arrOutputValues()                   As Variant
    
    Dim i                                   As Long
    Dim lngRowsData                         As Long
    
    Const strPatternDescriptions            As String = "\D+"
    Const strPatternValues                  As String = "\d+(\.\d{1,2})?"
    Const lngColumnDescriptions             As Long = 1
    Const lngColumnValues                   As Long = 2
    
    'Excel enrionment - speed things up
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
    
    'Initialize
        Set wb = ThisWorkbook
        With wb
            Set wsInput = .Worksheets("Input")
            Set wsOutput = .Worksheets("Output")
        End With
        
    'Clear previous output
        wsOutput.UsedRange.ClearContents
        
    'Input range without header
        With wsInput
            lngRowsData = GetRow(ws:=wsInput)
            Set rngInput = .Range(.Cells(2, 1), .Cells(lngRowsData, 1))
        End With
        
    'Transfer input range to input array
        arrInput = rngInput
        
    'Dimension output arrays
        ReDim arrOutputDescriptions(LBound(arrInput) To UBound(arrInput))
        ReDim arrOutputValues(LBound(arrInput) To UBound(arrInput))
        
    'Create a regular epression object
        Set RegEx = GetRegEx
        
    'Loop through each string in the input array
        For i = LBound(arrInput) To UBound(arrInput)
            
            'Pass the string to regular expression function to return the descriptive portion of the string
                arrOutputDescriptions(i) = GetSubString(objRegEx:=RegEx, _
                                                        strString:=CStr(arrInput(i, 1)), _
                                                        strPattern:=strPatternDescriptions)
                                                      
            'Pass the string to regualr expressions functions to return the value portion of the string
                arrOutputValues(i) = GetSubString(objRegEx:=RegEx, _
                                                  strString:=CStr(arrInput(i, 1)), _
                                                  strPattern:=strPatternValues)
        Next i
        
    'Output all elements of each array to an output range
    'Description in Column 1, Values in Column 2
        
        'Descriptions
            Call OutputArray(ws:=wsOutput, _
                             vTmpArray:=arrOutputDescriptions, _
                             lngColumn:=lngColumnDescriptions)
        
        'Values
            Call OutputArray(ws:=wsOutput, _
                             vTmpArray:=arrOutputValues, _
                             lngColumn:=lngColumnValues)
                             
    'Add a header to the data
        With wsOutput
            .Range("A1").EntireRow.Insert shift:=xlDown
            .Cells(1, 1) = "Descriptions"
            .Cells(1, 2) = "Values"
        End With

    'Tidy up
        'Erase arrays
            Erase arrInput
            Erase arrOutputDescriptions
            Erase arrOutputValues
            
        'Destroy objects
            Set RegEx = Nothing
            Set rngInput = Nothing
            Set wsInput = Nothing
            Set wsOutput = Nothing
            Set wb = Nothing
            
        'Restore Excel environment
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
                .Calculation = xlCalculationAutomatic
            End With
End Sub

 

Private Sub OutputArray(ws As Worksheet, _
                        vTmpArray() As Variant, _
                        lngColumn As Long)

    Dim j As Long
    
    For j = LBound(vTmpArray) To UBound(vTmpArray)
        ws.Cells(j, lngColumn).Value = vTmpArray(j)
    Next j
                      
End Sub

 

Private Function GetRow(ws As Worksheet) As Long

    GetRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

End Function

 

Private Function GetRange(ws As Worksheet, _
                          lngRowsStart As Long, _
                          lngRowsEnd As Long, _
                          lngColumn As Long) As Range

    Dim rng As Range

    With ws
        Set rng = .Range(.Cells(lngRowsStart, lngColumn), .Cells(lngRowsEnd, lngColumn))
    End With
    
    Set GetRange = rng
    
End Function

 

Private Function GetRegEx() As Object

    On Error Resume Next
    Set GetRegEx = CreateObject("VBScript.RegExp")

End Function

 

Private Function GetSubString(objRegEx As Object, _
                              strString As String, _
                              strPattern As String) As String
                              
    Dim reMatches As Object
    Dim strResult As String
    
    strResult = "No Match"
    
    With objRegEx
        .Pattern = strPattern
        .Global = True

        Set reMatches = .Execute(strString)
        
        If reMatches.Count <> 0 Then
            strResult = reMatches.Item(0)
        End If
    End With
    
    GetSubString = strResult

End Function

The Results

REOutput
Great! Exactly what I was looking for.

Tidy up

    Final Thoughts

    Regular Expressions are found in nearly all programming languages and much like Duct Tape, they have a Million and one uses. You are truly only limited by your imagination and ability to concoct the correct patterns. I use Regular Expressions as I Extract data from various Data Silos to Transform and normalize data prior to Loading to target reporting databases. Let us know how you use Regular Expressions in the comments.

    Downloads

    Download the workbook from OneDrive.

    Additional Resources