Question : Infinite loop when Range is only 1 cell

Just curious if anyone knows why this code would enter an infinite loop.  When there is more than one value visible in the column it works just fine.  I've added a simple conditional for now, but just curious to know if there is another way around it.

Code Snippet:

1: 2: 3:

For Each cel In .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible) cboUnit.AddItem cel.Offset(0, 1) Next cel

Open in New Window

Select All

Answer : Infinite loop when Range is only 1 cell

The problem is that SpecialCells has a bug in that it returns all the cells on the worksheet when used on only one cell. There are two basic solutions to work around the bug. You can use a replacement to SpecialCells (see below) or you can avoid using it:

  For Each cel In .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
     If Not cel.EntireRow.Hidden And Not cel.EntireColumn.Hidden Then cboUnit.AddItem cel.Offset(0, 1)
  Next cel

The function below implements the same functionality as the SpecialCells method with three differences: it operates as expected on single cells (uses the single cell versus the entire used range of the parent worksheet), it allows specification of multiple cell types, and it does not require that error handling be turned off. See the comments in the routine for more information about the parameters and usage.

[Begin Code Segment]

Public Function SpecialCells( _
     ByVal SourceRange As Range, _
     ByVal SpecialCellsType As Variant, _
     ByVal SpecialCellsValue As XlSpecialCellsValue _
  ) As Range

' Function returns the same result as the SpecialCells method with two
' differences: it allows multiple cell types to be specified and it operates
' correctly in single cells.
'
' Syntax
'
' SpecialCells(SourceRange, SpecialCellsType, SpecialCellsValue)
'
' SourceRange - A range object.
'
' SpecialCellsType - A single cell type or multiple cell types as an array. Use
'   the same constants as passed to the SpecialCells method.
'
' SpecialCellsValue - Same as the Value parameter to the SpecialCells method.
'
' Example - Find all numeric cells containing formulas or constants:
'   Set AllNumericCells = SpecialCells(UsedRange, Array(xlCellTypeConstants, xlCellTypeFormulas), xlNumbers)

  Dim SingleCellSource As Range
  Dim CellType As Variant
  Dim SpecialCellsRange As Range
  Dim ResultRange As Range
 
   If SourceRange.Cells.Count = 1 Then
     Set SingleCellSource = SourceRange
     If SourceRange.Row < SourceRange.Parent.Rows.Count Then
        Set SourceRange = SourceRange.Resize(2)
     Else
        Set SourceRange = SourceRange.Offset(-1).Resize(2)
     End If
  End If
 
   If Not IsArray(SpecialCellsType) Then SpecialCellsType = Array(SpecialCellsType)
 
   For Each CellType In SpecialCellsType
     Set SpecialCellsRange = Nothing
     On Error Resume Next
     Set SpecialCellsRange = SourceRange.SpecialCells(CellType, xlNumbers)
     On Error GoTo 0
     If Not SpecialCellsRange Is Nothing Then
        If ResultRange Is Nothing Then
           Set ResultRange = SpecialCellsRange
        Else
           Set ResultRange = Union(ResultRange, SpecialCellsRange)
        End If
     End If
  Next CellType
 
   If Not SingleCellSource Is Nothing And Not ResultRange Is Nothing Then
     Set ResultRange = Intersect(ResultRange, SingleCellSource)
  End If
 
   Set SpecialCells = ResultRange

End Function

[End Code Segment]

Kevin