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

, , ,

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
, , ,


Duke
 
I’m a sucker for a good western. Here’s John Wayne as Rooster Cogburn in True Grit the only film for which Wayne won the Oscar for Best Actor. Wayne and a partner owned a ranch not far from here and tales spin around the old town of Wayne and actor buddy, Lee Marvin, closing down a local cantina many a night back in the day.

But I digress, as this post is not about life out here in the open range of the wild west. Rather, it is about the Range Object of the Excel Object Model. The Range Object has 78 Methods and 96 Properties. I’ll take a look at some of these over a series of posts. I’ll begin with these methods:

  1. AdvancedFilter
  2. AutoFilter
  3. Find
  4. SpecialCells
  5. PasteSpecial

AdvancedFilter

Here’s a code snippet of the final code at the bottom that demonstrates some of the syntax for the AdvancedFilter Method:

Range.AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyToRange:=wsCriteria.Cells(1, 1), _
                Unique:=True

The most important parameters here are the Action and Unique parameters. This allows us to quickly get a unique list of data from the dataset that we can use as the criteria for the AutoFilter later

AutoFilter

Here’s a code snippet of the final code at the bottom that demonstrates some of the syntax for the AutoFilter Method:

    Range.AutoFilter _
             Field:=lngField, _
             Criteria1:=varCriteria

There are additional parameters available for the AutoFilter Method and I encourage you to investigate those. See the link at the bottom of this post. For now, I want to point out that I am passing variables to the named parameters. In the next section you’ll see how I use the Find Method to determine the column number of the header that I am interested in as “lngField”.

As I loop though the list of criteria created in the AdvancedFilter process I pass the value as “varCriteria” to the AutoFilter process.

Find

Here’s a code snippet of the final code at the bottom that demonstrates some of the syntax for the Find Method:

lngField = rngHeader.Find(What:=strFieldName, _
                          LookIn:=xlValues, _
                          LookAt:=xlWhole, _
                          MatchCase:=False).Column

The Find Method allows us to get a value at run-time using an InputBox for example, find the item, and pass the column number where the item is located to our process. This makes the process more robust and dynamic.

SpecialCells

Here’s a code snippet of the final code at the bottom that demonstrates some of the syntax for the SpecialCells Method:

Range.SpecialCells(xlCellTypeVisible).Copy

When most folks begin using VBA, they tend to loop through cells. However, SpecialCells used in conjunction with AutoFilter can offer much significant performance improvements as looping through cells tends to be slower. There are many types (enumeration) of SpecialCells. Link at bottom for full list. In the code sample below, I am using xlCellTypeVisible thereby ignoring all rows hidden by the AutoFilter.

PasteSpecial

Here’s a code snippet of the final code at the bottom that demonstrates some of the syntax for the PasteSpecial Method:

wbBifurcate.Worksheets("Sheet1").Cells(1, 1).PasteSpecial xlPasteValuesAndNumberFormats

There are 11 other paste types in the enumeration. I encourage you to explore them all. See the link at the bottom of this post.

Case Study: Bifurcate Excel File

ExcelSplitA common question posted on the LinkedIn Groups is, “How to split (bifurcate) an Excel file based on some criteria within the file?”

We need some test data so I downloaded a random data generator add-in over at Daily Dose of Excel by Dick Kusleika and whipped up some data:
 
BData
 Looks good so far. Now I’d like to bifurcate the master data into separate files based on the company name.

Get a unique list of company names

I’ll leverage the “unique” parameter of the AdvancedFilter Method of the Range Object

Range.AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyToRange:=wsCriteria.Cells(1, 1), _
                Unique:=True

CData

The Complete Code

Option Explicit

Sub BifurcateFile()

    'Author:Winston Snyder
    'Date: 12/7/2013
    'Purpose: Bifurcate master file into component files
    
    'Declare variables
        Dim wb As Workbook
        Dim wbBifurcate As Workbook
        Dim ws As Worksheet
        Dim wsCriteria As Worksheet
        Dim rngList As Range
        Dim rngData As Range
        Dim rngCriteria As Range
        Dim rngHeader As Range
        Dim r As Long
        Dim c As Long
        Dim i As Long
        Dim lngField As Long
        Dim rCriteria As Long
        Dim strFieldName As String
        Dim strPath As String
        Dim varCriteria As Variant
        
    'Excel environment - speed things up
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
        
    'Intialize variables
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets("Data")
        strFieldName = InputBox("Please enter the term to search for?") '<-Update as needed
        strPath = DocsPath & "Load Files\" '<-File output, update as needed
        r = ws.Cells(Rows.Count, 1).End(xlUp).Row
        c = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        
    'Add a worksheet to hold filtered data
    'This list will become the criteria list for bifurcating the master file
        Set wsCriteria = wb.Worksheets.Add(After:=Worksheets(Worksheets.Count))
        
    'Find column number to be filtered
        Set rngHeader = ws.Range(ws.Cells(1, 1), ws.Cells(1, c))
        lngField = rngHeader.Find(What:=strFieldName, _
                                  LookIn:=xlValues, _
                                  LookAt:=xlWhole, _
                                  MatchCase:=False).Column
        
    'Define the range to be filtered
        With ws
            If .FilterMode = True Then
                .ShowAllData
            End If
                        
            Set rngList = .Range(.Cells(1, lngField), .Cells(r, lngField))
            Set rngData = .UsedRange
        End With
        
    'Filter the range
        With rngList
            .AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyToRange:=wsCriteria.Cells(1, 1), _
                Unique:=True
        End With
        
    'Define the criteria range
    'Begin with row 2 to ignore the header row
        With wsCriteria
            rCriteria = .Cells(Rows.Count, 1).End(xlUp).Row
            Set rngCriteria = .Range(.Cells(2, 1), .Cells(rCriteria, 1))
        End With
        
    'Loop through criteria range
    'Use each value as criteria to apply to autofilter for data range
    'Create file
        For i = rngCriteria.Rows.Count To 1 Step -1
            varCriteria = rngCriteria.Cells(i, 1).Value
            
            'Add a workbook to hold filtered results
                Set wbBifurcate = Workbooks.Add
                
            'Filter the original data
                With ws
                    
                    'If data is filtered, remove filter
                        If .FilterMode = True Then
                            .ShowAllData
                        End If
                    
                    'Filter the data
                        .AutoFilterMode = False
                        If Not .AutoFilterMode Then
                            rngData.AutoFilter _
                                Field:=lngField, _
                                Criteria1:=varCriteria
                        End If
                            
                    'Copy the visible range of the data range - include the header row
                        rngData.SpecialCells(xlCellTypeVisible).Copy
                        wbBifurcate.Worksheets("Sheet1").Cells(1, 1).PasteSpecial xlPasteValuesAndNumberFormats
                        
                    'Remove the autofilter
                        If .AutoFilterMode = True Then
                            .AutoFilterMode = False
                        End If
                        
                End With
                
            'Save the bifurcated data workbook
                wbBifurcate.SaveAs strPath & varCriteria & ".xlsx", FileFormat:=51
                
            'Close the workbook
                wbBifurcate.Close
            
        Next i
        
    'Tidy up
        'Delete temporary worksheet
            wsCriteria.Delete
            
        'Delete objects
            Set rngList = Nothing
            Set rngData = Nothing
            Set rngCriteria = Nothing
            Set rngHeader = Nothing
            Set wsCriteria = Nothing
            Set ws = Nothing
            Set wbBifurcate = Nothing
            Set wb = Nothing
            
        'Excel environment - restore
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
                .Calculation = xlCalculationAutomatic
            End With
End Sub
Public Function DocsPath() As String
    
    'Purpose: Get the Environ value for User Docuents
    'Returns: C:\Users\%User Name%\Documents\
    
    DocsPath = Environ$("USERPROFILE") + "\Documents\"
End Function

I’m using the DocsPath function to get the Documents folder based on which user is logged in. This makes the code a bit more robust and transportable. I should really check for the existence of a subfolder or offer the user the option to create the subfolder if it does not exist – but I feel that complicates the code which may already be complicated enough.

Tidy up

    Final Thoughts

    The sample does take a little bit of time to run as there are 100K records and 100 unique company names – therefore 100 separate files. I’ve seen varying attempts to use passwords and other techniques to allow a user to only view certain data. However, the best way to make sure a user cannot access data that you do not want them to see is to make sure it is not in the workbook in the first place.

    The process may be faster if instead of looping through a range, we first transfer the range to an array and then loop the array to pass the elements of the array as criteria for the autofilter.

    Another option might be to get the size of each range after the autofilter, set the size of the receiving range and then transfer the value of one range to another. This would bypass the Windows Clipboard which is causing the process to run a little slower using the Copy-PasteSpecial. Something like:

    Set rngSource = Range.SpecialCells(xlCellTypeVisible)
    With rngSource
         rowsSource = .Rows.Count
         columnsSource = .Columns.Count
    End With
    
    Set rngDestination = wbBifurcate.Worksheets("Sheet1").Range("A1")
    Set rngDestination = rngDestination.Resize(rowsSource,columnsSource)
    
    rngDestination.Value = rngSource.Value
    

    The process I use above in the main code, may be used in conjunction with varying methods of automated distribution such as through Outlook or TransferSharePointList. Additionally, instead of pasting values into a new workbook, I could use a template workbook that has Pivot Tables, Charts, Formulas – everything that is needed – just need to append the new data or delete any old data and paste in the new data. I’ll post samples of those processes in future posts.

    Downloads

    Download the workbook from SkyDrive.

    Additional Resources

, ,