Defining a discontiguous Range object
Because nobody could suggest a non-looping way to grab a discontiguous
range, the looping version that I came up with is shown below. Because it
hides unwanted cells in blocks, and because Rows.Hidden = True is a fast
operation, this probably runs about as quickly as anything.
Charley
''================================================ ==========================
=====
'' Program: NonZeroRange
'' Desc: Returns a discontiguous range of all cells with a non-zero
value
'' found in a single-column range
'' Called by:
'' Call: NonZeroRange(rngData)
'' Arguments: rngData--The source range
'' Comments: This could be modified to use more sophisticated filters.
''
Changes---------------------------------------------------------------------
-
'' Date Programmer Change
'' 12/25/03 Charley Kyd Written
''================================================ ==========================
=====
Private Function NonZeroRange(rngData As Range) As Range
Dim rngCur As Range, rngStart As Range, bDoingZeros As Boolean
Dim gVal As Single
bDoingZeros = False
''Make sure all rows begin as unhidden
rngData.Rows.Hidden = False
For Each rngCur In rngData
''Trap error values. (Note: Using IIf doesn't work because it
''calculates both results, generating an error value.)
If IsError(rngCur) Then gVal = 0 Else gVal = Val(rngCur)
''If this is an item to hide...
If gVal = 0 Then
''If this is the first zero found in a block
If Not bDoingZeros Then
bDoingZeros = True
Set rngStart = rngCur
End If
''If this is a non-zero value
Else
''If we're done with a block of zeros...
If bDoingZeros Then
''Hide the current block, ending with the previous cell
Range(rngStart, rngCur.Offset(-1, 0)).Rows.Hidden = True
bDoingZeros = False
End If
End If
Next rngCur
''If the range ends with a zero...
If bDoingZeros Then
Range(rngStart,
rngData.SpecialCells(xlCellTypeLastCell)).Rows.Hid den = True
End If
''Define the range of searched-for values
Set NonZeroRange = rngData.SpecialCells(xlCellTypeVisible)
''Unhide the range
rngData.Rows.Hidden = False
End Function
|