FindLastCell function not working correctly

Question

I have used the following code, which will be familiar to many of you, for 15 years or more.

Public LCell As String, LC As Long, LR As Long

Public Function FindLastCell(wksht As Worksheet) As String

'Returns address of last cell (highest row & col) on wksht

    Dim LRow As Long

    Dim LCol As Long

    On Error GoTo FLCerr1

    With wksht

        LRow = 0

        LCol = 0

        LRow = _

            .Cells.Find("*", After:=.Cells(1), _

            LookIn:=xlFormulas, LookAt:=xlWhole, _

            SearchDirection:=xlPrevious, _

            SearchOrder:=xlByRows).Row

        LCol = _

            .Cells.Find("*", After:=.Cells(1), _

            LookIn:=xlFormulas, LookAt:=xlWhole, _

            SearchDirection:=xlPrevious, _

            SearchOrder:=xlByColumns).Column

    End With

    FindLastCell = Cells(LRow, LCol).AddressLocal

    Exit Function

FLCerr1:

'Empty worksheet, or unknown error.

    FindLastCell = "ERROR"

End Function

This function has always worked perfectly for me - until last Friday afternoon. On a payroll file I was working with, this function began to return A1 under the following conditions: AutoFilter was applied. Row 2 was not hidden as a result.

If I filter differently so that row 2 is hidden, the function works correctly.

I did a few tests with the following data:

A1 = AAA

B1 = BBB

C1 = CCC

D1 = DDD

A2:A8 = x

B2:B8 = letters b:h (one letter per cell)

C2:C3 = 3

C4 = 2

C5 = 1

C6 = 3

C7:C8 = 1

D2 = w

Unfiltered, the function returns D8 (correct).

If I filter column C for the value 3, the function returns C6 (should be D6).

If I instead filter column B for the value in row 6, the function returns C6 (should be D6).

My coworkers get the same results on their computers (all Windows 7, Excel 2010), and I get the same results on my Vista computer at home.

Does anyone know what is causing these errant results? Any suggestions/workarounds?

Thanks,

Hutch

Answer 1

Thanks for the reply & interesting code. Your explanation doesn't help me understand why the function has worked flawlessly for 15 years (including use on fitlered ranges), but gives erratic results now.

The reason might be that the last row/column was always filled and visible...

MS has not changed anything in this behavior, you're lucky that the issue did not occurred (or no one has noticed).

I guess you want to have all visible cells of the used range, the code below might be helpful.

BTW, if you want to get the filtered data only, access the AutoFilter.Range object in that sheet.

Andreas.

Option Explicit

Sub Test()

  Debug.Print RangeVisible(RangeUsedRange(Cells)).Address

  Debug.Print RangeSurround(IntersectA( _

    SpecialCells(Cells, xlCellTypeVisible), _

    UnionA(SpecialCells(Cells, xlCellTypeConstants), _

    SpecialCells(Cells, xlCellTypeFormulas)))).Address

End Sub

Function SpecialCells(ByVal R As Range, ByVal Typ As XlCellType, _

    Optional ByVal Value As XlSpecialCellsValue = &H17) As Range

  'Avoid the SpecialCells-BUG to return all cells from the current region

  On Error Resume Next

  Select Case Typ

    Case xlCellTypeConstants, xlCellTypeFormulas

      Set SpecialCells = Intersect(R, R.SpecialCells(Typ, Value))

    Case Else

      Set SpecialCells = Intersect(R, R.SpecialCells(Typ))

  End Select

End Function

Function IntersectA(ParamArray Args()) As Range

  'Same as Intersect, but skips ranges which are Nothing

  Dim i As Integer

  For i = LBound(Args) To UBound(Args)

    If IntersectA Is Nothing Then

      Set IntersectA = Args(i)

    ElseIf Not Args(i) Is Nothing Then

      Set IntersectA = Intersect(IntersectA, Args(i))

    End If

  Next

End Function

Function UnionA(ParamArray Args()) As Range

  'Same as Union, but skips ranges which are Nothing

  Dim i As Integer

  For i = LBound(Args) To UBound(Args)

    If UnionA Is Nothing Then

      Set UnionA = Args(i)

    ElseIf Not Args(i) Is Nothing Then

      Set UnionA = Union(UnionA, Args(i))

    End If

  Next

End Function

Function RangeVisible(ByVal R As Range) As Range

  'Returns the used range of R

  Dim C As Range

  On Error Resume Next

  Set R = Intersect(R, R.SpecialCells(xlCellTypeVisible))

  On Error GoTo 0

  If R Is Nothing Then

    If C Is Nothing Then Exit Function

    Set R = C

  ElseIf Not C Is Nothing Then

    Set R = Union(R, C)

  End If

  Set RangeVisible = RangeSurround(R)

End Function

Function RangeUsedRange(ByVal R As Range) As Range

  'Returns the surrounding used range of R

  Dim C As Range

  On Error Resume Next

  Set C = Intersect(R, R.SpecialCells(xlCellTypeFormulas))

  Set R = Intersect(R, R.SpecialCells(xlCellTypeConstants))

  On Error GoTo 0

  If R Is Nothing Then

    If C Is Nothing Then Exit Function

    Set R = C

  ElseIf Not C Is Nothing Then

    Set R = Union(R, C)

  End If

  Set RangeUsedRange = RangeSurround(R)

End Function

Function RangeTopLeft(ByVal R As Range) As Range

  'Returns the intersecting top leftmost cell of all areas in R

  Dim Area As Range

  Dim FirstRow As Long, FirstCol As Long, i As Long

  If R Is Nothing Then Exit Function

  FirstRow = R.Row + R.Rows.Count

  FirstCol = R.Column + R.Columns.Count

  For Each Area In R.Areas

    i = Area.Row

    If i < FirstRow Then FirstRow = i

    i = Area.Column

    If i < FirstCol Then FirstCol = i

  Next

  Set RangeTopLeft = R.Parent.Cells(FirstRow, FirstCol)

End Function

Function RangeBottomRight(ByVal R As Range) As Range

  'Returns the intersecting bottom rightmost cell of all areas in R

  Dim Area As Range

  Dim LastRow As Long, LastCol As Long, i As Long

  If R Is Nothing Then Exit Function

  For Each Area In R.Areas

    i = Area.Row + Area.Rows.Count - 1

    If i > LastRow Then LastRow = i

    i = Area.Column + Area.Columns.Count - 1

    If i > LastCol Then LastCol = i

  Next

  Set RangeBottomRight = R.Parent.Cells(LastRow, LastCol)

End Function

Function RangeSurround(ByVal R As Range) As Range

  'Returns the surrounding range of R

  Dim Area As Range

  Dim FirstRow As Long, FirstCol As Long, i As Long

  Dim LastRow As Long, LastCol As Long

  If R Is Nothing Then Exit Function

  FirstRow = R.Row

  FirstCol = R.Column

  For Each Area In R.Areas

    i = Area.Row

    If i < FirstRow Then FirstRow = i

    i = Area.Column

    If i < FirstCol Then FirstCol = i

    i = Area.Row + Area.Rows.Count - 1

    If i > LastRow Then LastRow = i

    i = Area.Column + Area.Columns.Count - 1

    If i > LastCol Then LastCol = i

  Next

  With R.Parent

    Set RangeSurround = .Range(.Cells(FirstRow, FirstCol), .Cells(LastRow, LastCol))

  End With

End Function

Answer 2

Hi Andreas,

Thanks for the reply & interesting code. Your explanation doesn't help me understand why the function has worked flawlessly for 15 years (including use on fitlered ranges), but gives erratic results now.

If I set IgnoreHiddenCells to False, your code gives me the expected results on my filtered payroll data. However, it gives the wrong results on the test data I provided above. When I filter column C for the value 3 as described above, your code returns C6, although there is data visible in column D.

Answer 3

The reason is that FIND skips hidden cells, and then your range has areas, so FIND returns other cells as you expected.

Try the function below as sub Test shows.

Andreas.

Sub Test()

  Debug.Print RangeLastCell(Cells, True).Address

End Sub

Function RangeLastCell(ByVal Where As Range, _

    Optional ByVal IgnoreHiddenCells As Boolean) As Range

  'Returns the last used cell in Where

  Dim R As Range, C As Range

  Dim LastRow As Long, LastCol As Long, i As Long

  If IgnoreHiddenCells Then

    On Error Resume Next

    Set R = Intersect(Where, Where.SpecialCells(xlCellTypeConstants))

    Set C = Intersect(Where, Where.SpecialCells(xlCellTypeFormulas))

    On Error GoTo 0

    If R Is Nothing Then

      Set R = C

      If R Is Nothing Then

        Set RangeLastCell = Where(1, 1)

        Exit Function

      End If

    ElseIf Not C Is Nothing Then

      Set R = Union(R, C)

    End If

    For Each C In R.Areas

      i = C.Row + C.Rows.Count - 1

      If i > LastRow Then LastRow = i

      i = C.Column + C.Columns.Count - 1

      If i > LastCol Then LastCol = i

    Next

    Set RangeLastCell = Where(LastRow - Where.Row + 1, _

      LastCol - Where.Column + 1)

  Else

    Set R = Where.Cells(Where.Rows.Count, Where.Columns.Count)

    If IsEmpty(R) And Not R.Address = Where.Cells(1, 1).Address Then

      Set C = Where.Find("*", After:=R, SearchOrder:=xlByColumns, _

        SearchDirection:=xlPrevious)

      If C Is Nothing Then

        Set RangeLastCell = Where(1, 1)

      Else

        Set R = Where.Find("*", After:=R, SearchOrder:=xlByRows, _

          SearchDirection:=xlPrevious)

        Set RangeLastCell = Where.Cells(R.Row - Where.Row + 1, _

          C.Column - Where.Column + 1)

      End If

    Else

      Set RangeLastCell = R

    End If

  End If

End Function