Excel

Adjust range to exclude irrelevant cells

Ease of Use

Intermediate

Version tested with

2000, 2003 

Submitted by:

Ken Puls

Description:

This macro only considers cells that hold either text, values or formulas for evaluation. Since all the other cells are removed from the range, it can drastically speed up For Next loops since irrelevant cells are not evaluated. 

Discussion:

One large issue when working with code that uses a For Next loop on all cells in a user selected area (For Each cell in Selection) is that many irrelevant cells can be included in the range. In the worst case, a user can select the entire worksheet, meaning that almost 1.7 million cells need to be evaluated. This code takes advantage of Excel's SpecialCells method to thin down the range to only include cells of a certain type (ie Text, Numbers, or Formulas), making the range as small as possible. When this new and smaller range is passed back to your procedure, it could dramatically speed up your loop. 

Code:

instructions for use 

			
Option Explicit 
 
Function TrimRange(rng As Range, Optional ReqType As Variant) 
    Dim CellType As Long, SpcCells As Long 
     
     'Assign "Text" if optional parameter was not supplied
    If IsMissing(ReqType) Then ReqType = 1 
     
     'Assign required variables based on optional parameter
    Select Case ReqType 
    Case Is = 1, "Text" 
        CellType = 2 'Constants
        SpcCells = 2 'Text
    Case Is = 2, "Values" 
        CellType = 2 'Constants
        SpcCells = 1 'Values
    Case Is = 3, "Formulas" 
        CellType = -4123 'Formulas
        SpcCells = 3 'Text and Values
         'Change 3 to 1 for value formulas only, or
         'change 3 to 2 for text formulas only
    End Select 
     
     'Limit the range to only selected cells holding desired info
    On Error Resume Next 
    Select Case rng.Count 
    Case Is = 1 
        Set TrimRange = rng 
    Case Else 
        Set TrimRange = rng.SpecialCells(CellType, SpcCells) 
    End Select 
     
     'If no cells meet criteria then assign top left cell of supplied
     'range to avoid error on return to calling procedure
    If Err.Number <> 0 Then 
        Set TrimRange = rng.Range("A1") 
    End If 
    On Error GoTo 0 
End Function 
 
Sub TestTrimRange() 
     'Test the TrimRange function
    Dim selRange As Range 
     
     'Set range to trim
    Set selRange = TrimRange(Selection, 1) 
     
     'Select trimmed range for display purposes
     'Normally, you would start your loop here, such as:
     'For Each cell in selRange...
    selRange.Select 
End Sub

How to use:

  1. Copy above code.
  2. In Excel press Alt + F11 to enter the VBE.
  3. Press Ctrl + R to show the Project Explorer.
  4. Right-click desired file on left (in bold).
  5. Choose Insert -> Module.
  6. Paste code into the right pane.
  7. If you want to restore to the application's default font, remove the ' from the line noted in the middle of the code.
  8. Press Alt + Q to close the VBE.
  9. Save workbook before any other changes.
 

Test the code:

  1. Place a variety of data on your worksheet. (Numbers, text, and formulas that have both numeric and text results.)
  2. Highlight a range of cells.
  3. Press Alt + F8 to display the Macro dialog box.
  4. Choose TestTrimRange and click Okay.
  5. Verify that only cells holding Text have been selected (and not formulas that show Text results).
  6. To modify this to show other results, change the "1" in the line in TestTrimRange that reads: Set selRange = TrimRange(Selection, 1):
  7. 1 or "Text" (with the quotes), or just leaving off the ",1" will select text only
  8. 2 or "Values" (with the quotes) will select numbers only
  9. 3 or "Formulas" (with the quotes) will select formulas only (showing text or numbers)
 

Sample File:

TrimRange.zip 16.63KB 

Approved by mdmackillop


This entry has been viewed 204 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express