Neil Dunlop
Neil Dunlop

Reputation: 405

How to find the true Last Cell in any Worksheet

This question is now answered elegantly, thanks to Chris Neilsen, see the answer below. It is the one I will use from now on. The solution reliably finds the last cell in a Worksheet, even when cells are hidden by Filters, Groups or Local hiding of rows.

The discussion may be informative to some, so I have provided an optimised version of my own code too. It demonstrates how to save and restore Filters, uses @Chis's ideas for finding the last Row, and records Hidden Row Ranges in a short Variant array from which they are finally restored.

A test Workbook that explores and tests all the solutions proposed discussed is also available to download here.

THE FULL QUESTION AND DISCUSSION, AS UPDATED

There is much discussion here and elsewhere on finding last cells in Excel Worksheets. The Range.SpecialCells method has limitations and does not always find the true last cell. This is particularly true if Worksheet.AutoFilters are active. The code below solves the problem and returns the correct result, even if Filters are active, cells are Grouped and Hidden, or Rows or Columns are Hidden using Hide/Unhide. However, the method is not simple. Does anybody know of a better method that is consistently reliable?

The 'true last cell' is understood to be the intersection of the last row containing data or formulae and the last column containing them. Formatting may extend past it.

Credits and thanks for good ideas: to readify and sancho s.

The code below tests and works in my application in Excel 2010 and requires that Scripting.Runtime is referenced in the VBIDE. It contains inline comments that document what it is doing and why. Also, the variable names are deliberately explanatory. Sorry, but this makes them long.

In some circumstances it may not restore the exact Rows that were hidden when it is called. I have never had this happen.

Edit 1 to the question

Thanks to the 3 kind respondees on 1/3/2016.
This follows on from brettdj marking the question as already answered. Regrettably, I do not believe that to be true. At least, not unless UsedRange can be trusted in all circumstances. Though problems with SpecialCells are hard to reproduce, previous experience with the values provided by SpecialCells discourages reliance on them.

brettdj's post Return a range from A1 to the true last used cell provides a solution, GetRange. It is one amongst others but appears to be clearly the best. I have tested it and all the solutions proposed in this thread. In my tests, none of them are able to find the last cell when a filter is active without trusting UsedRange. brettdj, of high reputation, clearly thinks otherwise but it appears to me that I really have detected a real issue.

To demonstrate:

See the following test Sheet. All rows and columns are exposed in this view. Note Row 19 with the text 'Row to hide with filter' in H19. Also note that there is information in Row 20 at B20 and in Column J at J11. (Obviously, as this is a test, there is nothing in J20 the Cell whose reference is the correct answer to the Question): Test Worksheet is it with all rows and columns exposed

Tests were run on the Sheet above but with a filter active (emphasised by a red circle in the image below) which removes row 19 from view. During the tests the Column Group J:K was collapsed but the Row Group over 19:20 was left visible.

These are the results (the true answer is J20):

enter image description here

In the unlikely case that this is Operating System specific, my test was run on {you're not allowed to laugh -:)} Vista Home Premium. My excuse is that it is 64Bit OS on a lightning fast 8 core machine, even if it is ageing. Excel 2010, 32 bit Version 14.0.7166.5000.

Edit 2 in response

In response to chris neilsen's request for validation and a test file upload it is no longer here. The short answer is : The problem is all too reproducible on Windows 10 running Office 2013 15.0.4797.1003 as well as on Vista - Office 2010. Sadly, this is real. The Workbook from which the images were taken now contains the code for each the suggestions made here (to date 2 March 2016). The public file downloads OK and reproduces the results on a Windows 7/Office 2010 machine. To run the tests, look for the Module TestSolutionsProposed in the VBIDE. The Debug.Prints from the tests give identical same results on W10, W7, Vista and Office 2010 & 2013 (correct answer is J20):

Brettdj's GetRange gives: Range is A1:B20 WS usedrange = $A$1:$K$20 PatrickK's GetTrueLastCell gives Found last cell = $K$20 Gary's Student's TrueLastCell gives: The TRUE last cell is B20 My GetTrueLastCell (with RemoveFiltersAsBoolean = False) gives: Last cell address is B20 My GetTrueLastCell (with RemoveFiltersAsBoolean = True) gives: Last cell address is J20

@brettdj - please can you restore the status of this question? Surely it is reproducible by others - how could the results be specific to three separate systems I can get access to but not to others? Only removal of the filters gives the correct answer. Note: The filter has to be both present and active to show the problem; as uploaded, the Test Workbook is set to give the results above; it is not enough to have AutoFitlerMode = True. One of the filters must have a filter criterion active - in the example H19 is hidden.

Private Function GetTrueLastCell(ws As Excel.Worksheet, _
                        Optional lRealLastRow As Long, _
                        Optional lRealLastColumn As Long, _
                        Optional RemoveFiltersAsBoolean As Variant = False) As Range
'Purpose:
'Finds the cell at the intersection of the last Row containing any data and the last Column containing any data,
' even if some cells are hidden by Filters, Grouping or are locally Hidden.  If there are no filters uses a simple method.
'Returns:   the LastCell as a Range; Optionally returns Row and Column indeces.
' If the WS has no data or is not a WS, returns GetTrueLastCell=Nothing & lRealLastRow=0 & RealLastColumn=0
'Developed by extension of ideas from:
' 'Readify' for ideas about saving and restoring filters,
'   see: https://stackoverflow.com/questions/9489126/in-excel-vba-how-do-i-save-restore-a-user-defined-filter
' 'Sancho s' 24/12/2014, see https://stackoverflow.com/questions/24612874/finding-the-last-cell-in-an-excel-sheet
'Written by Neil Dunlop 29/2/2016
'History: 2016 03 03 added optimisation of the reapplication of filters following discussion on StackOverFlow wiht
' thanks to Chris Neilsen for review and comments and ideas - see here:
' https://stackoverflow.com/questions/35712424/how-to-find-the-true-last-cell-in-any-worksheet
'Notes:
'This will find the last cell even if rows are Hidden by any means.
' This is partly accomplished by setting Lookin:=xlFormulas,
' and partly by removing and restoring filters that prevent .Find looking in a cell.
'Requirements:
' The reference to Microsoft Scripting Runtime must be present in the VBIDE's Tools>References list.
    Dim FilteredRange As Range, rng As Range
    Dim wf As Excel.WorksheetFunction
    Dim MyCriteria1 As Scripting.Dictionary
    Dim lr As Long, lr2 As Long, lr3 As Long
    Dim i As Long, j As Long, NumFilters As Long
    Dim CurrentScreenStatus As Boolean, LastRowHidden As Boolean
    Dim FilterStore() As Variant, OutlineHiddenRow() As Variant

    If Not RemoveFiltersAsBoolean Then GoTo JUSTSEARCH
    CurrentScreenStatus = Excel.Application.ScreenUpdating
    Excel.Application.ScreenUpdating = False
    On Error GoTo BADWS
    If ws.AutoFilterMode Then
        'Save all active Filters
        With ws.AutoFilter
            If .Filters.Count > 0 Then
                Set FilteredRange = .Range
                For i = 1 To .Filters.Count
                    If .Filters(i).On Then
                        NumFilters = NumFilters + 1
ReDim Preserve FilterStore(0 To 4, 1 To NumFilters)
                        FilterStore(0, NumFilters) = i                  'The Column to which the filter applies
                        'If there are only 2 Filters they will be in Criteria1 and Criteria2.
                        'Above 2 Filters, Criteria1 contains all the filters in a Scripting Dictionary
                        FilterStore(1, NumFilters) = .Filters(i).Count  'The number of conditions active within this filter
                        Select Case .Filters(i).Count
                        Case Is = 1     'There is 1 filter in Criteria1
                            FilterStore(2, NumFilters) = .Filters(i).Criteria1
                        Case Is = 2     'There are 2 Filters in Criteria1 and Criteria2
                            FilterStore(2, NumFilters) = .Filters(i).Criteria1
                            FilterStore(3, NumFilters) = .Filters(i).Criteria2
                        Case Else       'There are many filters, they need to be in a Scripting Dictionary in Criteria1
                            Set MyCriteria1 = CreateObject("Scripting.Dictionary")
                            MyCriteria1.CompareMode = vbTextCompare
                            For j = 1 To .Filters(i).Count
                                MyCriteria1.Add Key:=CStr(j), Item:=.Filters(i).Criteria1(j)
                            Next j
                            Set FilterStore(2, NumFilters) = MyCriteria1
                        End Select
                        If .Filters(i).Operator Then
                            FilterStore(4, NumFilters) = .Filters(i).Operator
                        End If
                    End If
                Next i
            End If ' .Filters.Count > 0
        End With
        'Check for and store any hidden Outline levels applied to the Rows.
        'At this stage the last cell is not known, so the best available estimate , UsedRange,
        ' is used in the Row loop. The true maximum row number with data may be less than the
        ' highest row from UsedRange. The code below reduces the maximum estimated efficiently.
        'It is believed that UsedRange is never too small; it it were, then the hidden properties
        ' of some rows may not be stored and will therefore not be restored later.
        '---------get a true last row---------------------------------------------------------
        Set rng = ws.Range(ws.Cells(1, 1), ws.UsedRange.Cells(ws.UsedRange.Cells.CountLarge))
        Set wf = Application.WorksheetFunction
        With rng                            'Code from Chris Neilsen
            lr = .Rows.Count + .Row - 1
            lr2 = lr \ 2
            lr3 = lr2 \ 2
            Do While (lr - lr2) > 30
                'Debug.Print "r", lr2, lr
                If wf.CountA(.Rows(lr2 & ":" & lr)) = 0 Then
                    lr = lr2
                    lr2 = lr3
                    lr3 = lr2 \ 2
                Else
                    lr3 = lr2
                    lr2 = (lr + lr2) \ 2
                End If
            Loop
            For i = lr To 1 Step -1
                If wf.CountA(.Rows(i)) <> 0 Then Exit For
            Next i
            lr = i
        End With ' rng
        '---------record and unhide any hidden Row--------------------------------------------
        j = 0
        LastRowHidden = False
        For i = 1 To lr
            If (Not ws.Rows(i).Hidden And LastRowHidden) Then
                                                                    'End of a Hidden Rows Range, record the Range
                Set OutlineHiddenRow(2, j) = ws.Rows(OutlineHiddenRow(1, j) & ":" & i - 1)
                LastRowHidden = False
            ElseIf ws.Rows(i).Hidden And Not LastRowHidden Then     'Start of Hidden Rows Range, record the Row
                j = j + 1
ReDim Preserve OutlineHiddenRow(1 To 2, 1 To j) ' 1 -first row found to be Hidden, 2 - Range of Hidden Rows(i:j)
                If i <> lr Then
                    OutlineHiddenRow(1, j) = i
                    LastRowHidden = True
                Else                                                'Last line in range is hidden all on its own
                    Set OutlineHiddenRow(2, j) = ws.Rows(i & ":" & i)
                End If
            ElseIf LastRowHidden And ws.Rows(i).Hidden And i = lr Then 'Special case is for Hidden Range ending on last Row
                Set OutlineHiddenRow(2, j) = ws.Rows(OutlineHiddenRow(1, j) & ":" & i)
            Else
                'Nothing to do
            End If
        Next i
        NumFilters = j
        'Remove the AutoFilter, if any of the filters were On.
        ' This changes the hidden setting for ALL Rows (but NOT Columns) to visible
        ' irrespective of the reason for their having become hidden (Filter, Group, local Hide).
        If NumFilters > 0 Then ws.AutoFilterMode = False
    End If ' WS.AutoFilterMode

JUSTSEARCH:
'Search for the last cell that contains any sort of 'formula'.
'xlPrevious ensures that the search starts from the end of the last Row or Column (it's the next cell after (1,1)).
'LookIn:=xlFormulas ensures that the search includes a search across Hidden data.
' However, if ANY filters are active the search NO LONGER LOOKS IN HIDDEN CELLS. Also the reverse search
' starts at the end of the column or row containing (1,1) instead of starting at the very end row and column.
' This is why all filters have to be stored, removed and reapplied to find the correct end cell.
    lRealLastColumn = ws.Cells.Find(What:="*", _
                                   After:=ws.Cells(1, 1), _
                                  LookIn:=xlFormulas, _
                                  LookAt:=xlPart, _
                             SearchOrder:=xlByColumns, _
                         SearchDirection:=xlPrevious, _
                               MatchCase:=False, _
                               MatchByte:=False, _
                            SearchFormat:=False).Column
    If lr = 0 Then
        lRealLastRow = ws.Cells.Find(What:="*", _
                                    After:=ws.Cells(1, 1), _
                                   LookIn:=xlFormulas, _
                                   LookAt:=xlPart, _
                              SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                                MatchCase:=False, _
                                MatchByte:=False, _
                             SearchFormat:=False).Row
    Else
        lRealLastRow = lr
    End If
    Set GetTrueLastCell = ws.Cells(lRealLastRow, lRealLastColumn)
'Restore the saved Filters to their Rows.
    If NumFilters Then
        'Restore the original AutoFilter settings
        FilteredRange.AutoFilter
        With ws.AutoFilter
            For i = 1 To UBound(FilterStore, 2)
                If FilterStore(4, i) Then               'There is an Operator
                    If FilterStore(1, i) > 2 Then       'There is a ScriptingDictionary for Criteria1
                       FilteredRange.AutoFilter Field:=FilterStore(0, i), _
                                                Criteria1:=FilterStore(2, i).Items, _
                                                Criteria2:=FilterStore(3, i), _
                                                Operator:=FilterStore(4, i)
                    Else                                'Criteria 1 is a string
                        FilteredRange.AutoFilter Field:=FilterStore(0, i), _
                                                 Criteria1:=FilterStore(2, i), _
                                                 Criteria2:=FilterStore(3, i), _
                                                 Operator:=FilterStore(4, i)
                    End If
                Else                                    'No Operator
                    If FilterStore(1, i) > 2 Then       'There is a ScriptingDictionary for Criteria1
                        FilteredRange.AutoFilter Field:=FilterStore(0, i), _
                                                 Criteria1:=FilterStore(2, i).Items
                    Else                                'Criteria 1 is a string
                        FilteredRange.AutoFilter Field:=FilterStore(0, i), _
                                                 Criteria1:=FilterStore(2, i)
                    End If
                End If
            Next i
        End With
    End If ' NumFilters
    If NumFilters > 0 Then
        'Restore the Hidden status of any Rows that were revealed by setting WS.AutoFilterMode = False.
        'Rows, not columns are filtered. Columns' Hidden status does not need to be restored
        ' because AutoFilter does not unhide Columns.
        For i = 1 To NumFilters
            OutlineHiddenRow(2, i).Hidden = True                'Restore the hidden property to the stored Row Range
        Next i
    End If ' NumFilters > 0
    GoTo ENDFUNCTION
BADWS:
    lRealLastRow = 0
    lRealLastColumn = 0
    Set GetTrueLastCell = Nothing
ENDFUNCTION:
    Set wf = Nothing
    Set MyCriteria1 = Nothing
    Set FilteredRange = Nothing
    Excel.Application.ScreenUpdating = CurrentScreenStatus
End Function

Upvotes: 5

Views: 2586

Answers (5)

Zsolt J
Zsolt J

Reputation: 1

Best way I know to find "true Last Cell" is to use 2 steps:

  1. Pick last cell of UsedRange (i.e. UsedRange.Cells.CountLarge)
  2. Move left & up until you find last non-empty row & column with CountA (i.e. WorksheetFunction.CountA(Range)), as it is fast, and works with Hidden / AutoFiltered / Grouped ranges.

This takes some time, so I've written an optimized code for the second step. Then I found @Chris' code edited on Nov 30, 2019, and it looked similar, though I was wondering why so different. I compared (...did my best to do apple v apple), and was surprised by the results.

If my tests are reliable, then all what matters is how many searches you do with CountA. I call it cycle - it is actually the number of CountA functions! My routine does up to 34 cycles, and @Chris' routine seems to do up to 32..80+ cycles. His code seems to test the same ranges repeatedly.

Please have a look at the test table Link, see my test results in VBA notes, and watch Immediate for your live results. You may test with any content, or even use an ActiveSheet in your own WorkBook. Play with parameters in VBA at "==== PARAMETERS TO BE CHANGED ====". You may zoom to 10%-15% to see painted cells showing the search ranges for each cycle. That's where the number of cycles becomes visible.

Note: I have not found any side-effects or errors with this so far. I avoid using Range.Find, and changing its parameters behind the scenes. Some users will learn it the hard way... - like I did, when I then replaced text in the entire workbook, just to find it out days later. Note2: This is my first post, please excuse possible glitches here.

Function GetLastSheetCellRng(ws As Excel.Worksheet) As Range
'Returns the [Range] of last used cell of the specified [Worksheet], located in the cross-section of the bottom row and right column with non-empty cells
Dim wf As Excel.WorksheetFunction: Set wf = Application.WorksheetFunction
Dim Xfound&, Yfound&, Xfirst&, Yfirst&, Xfrom&, Yfrom&, Xto&, Yto As Long

With ws
    '1. step: UsedRange last cell
    Set GetLastSheetCellRng = .UsedRange.Cells(.UsedRange.Cells.CountLarge) 'Getting UsedRange last cell
    Yfound = GetLastSheetCellRng.Row: Xfound = GetLastSheetCellRng.Column

    '2. step: Check non-empty cells in UsedRange last cell row & column
    'If not found, then search up for last non-empty row, and search left for last non-empty column
    If (wf.CountA(.Rows(Yfound)) = 0) And (Yfound > 1) Then
        Yto = Yfound
        Yfrom = Yto \ 2
        Yfirst = 0
        Do
            If wf.CountA(.Range(.Rows(Yfrom), .Rows(Yto))) <> 0 Then
                Yfirst = Yfrom
                Yfrom = (Yfirst + Yto + 0.5) \ 2
            Else
                Yto = Yfrom - 1
                Yfrom = (Yfrom + Yfirst) \ 2
            End If
        Loop Until Yfirst = Yfrom
        If Yfirst = 0 Then
            Yfound = 1 'If no cell found, then 1st row returned
        Else
            Yfound = Yfirst
        End If
    End If
    If (wf.CountA(.Columns(Xfound)) = 0) And (Xfound > 1) Then
        Xto = Xfound
        Xfrom = Xto \ 2
        Xfirst = 0
        Do
            If wf.CountA(.Range(.Columns(Xfrom), .Columns(Xto))) <> 0 Then
                Xfirst = Xfrom
                Xfrom = (Xfirst + Xto + 0.5) \ 2
            Else
                Xto = Xfrom - 1
                Xfrom = (Xfrom + Xfirst) \ 2
            End If
        Loop Until Xfirst = Xfrom
        If Xfirst = 0 Then
            Xfound = 1 'If no cell found, then 1st column returned
        Else
            Xfound = Xfirst
        End If
    End If
    Set GetLastSheetCellRng = .Cells(Yfound, Xfound)
End With
End Function

Upvotes: 0

chris neilsen
chris neilsen

Reputation: 53136

Based on @Gary's method, but optimised to work fast when the UsedRange is Large but not reflective of the True Last Cell (as can happen when a cell on the extreames of a worksheet is inadvertently formatted)

It works by, starting with the UsedRange, counting cells in half the range and halving the referenced test range above or below the split point depending on the count result, and repeating until it reaches < 5 rows/columns, then uses a linear search from there.

Function TrueLastCell( _
  ws As Excel.Worksheet, _
  Optional lRealLastRow As Long, _
  Optional lRealLastColumn As Long _
  ) As Range
    Dim lrTo As Long, lcTo As Long, i As Long
    Dim lrFrom As Long, lcFrom As Long
    Dim wf As WorksheetFunction
    Set wf = Application.WorksheetFunction

    With ws.UsedRange
        lrTo = .Rows.Count
        lcTo = .Columns.Count

        lrFrom = lrTo \ 2
        Do While (lrTo - lrFrom) > 2
            If wf.CountA(.Rows(lrFrom & ":" & lrTo)) = 0 Then
                lrTo = lrFrom - 1
                lrFrom = lrFrom \ 2
            Else
                lrFrom = (lrTo + lrFrom) \ 2
            End If
        Loop

        If wf.CountA(.Rows(lrFrom & ":" & lrTo)) = 0 Then
            lrTo = lrFrom - 1
        Else
            For i = lrTo To lrFrom Step -1
                If wf.CountA(.Rows(i)) <> 0 Then
                    Exit For
                End If
            Next i
            lrTo = i
        End If

        lcFrom = lcTo \ 2
        Do While (lcTo - lcFrom) > 2
            If wf.CountA(Range(.Columns(lcFrom), .Columns(lcTo))) = 0 Then
                lcTo = lcFrom - 1
                lcFrom = lcFrom \ 2
            Else
                lcFrom = (lcTo + lcFrom) \ 2
            End If
        Loop


        If wf.CountA(Range(.Columns(lcFrom), .Columns(lcTo))) = 0 Then
            lcTo = lcFrom - 1
        Else
            For i = lcTo To 1 Step -1
                If wf.CountA(.Columns(i)) <> 0 Then
                    Exit For
                End If
            Next i
            lcTo = i
        End If

        Set TrueLastCell = .Cells(lrTo, lcTo)
        lRealLastRow = lrTo + .Row - 1
        lRealLastColumn = lcTo + .Column - 1
    End With
End Function

On my hardware it runs in about 2ms on a sheet with UsedRange extending to the sheet limits and True Last Cell at F5, and 0.1ms when UsedRange reflects the True Last Cell at F5

Edit: slightly more optimised search

Upvotes: 5

brettdj
brettdj

Reputation: 55692

Great question.

As you note, Find failes with AutoFilter. As an alternative to looping through the filters, or the range loop used by another answer you could

  • Copy the sheet and remove the AutoFilter
  • use xlformulas in the Find routine which caters to hidden cells

So something lke this:

Sub GetRange()
'by Brettdj, http://stackoverflow.com/questions/8283797/return-a-range-from-a1-to-the-true-last-used-cell
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim ws As Worksheet

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    ActiveSheet.Copy

    Set ws = ActiveSheet
    With ws
    .AutoFilterMode = False
    Set rng1 = ws.Cells.Find("*", ws.[a1], xlFormulas, , xlByRows, xlPrevious)
    Set rng2 = ws.Cells.Find("*", ws.[a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
        MsgBox "Range is " & rng3.Address(0, 0)
        Debug.Print "Brettdj's GetRange gives: Range is " & rng3.Address(0, 0)  'added for this test by ND
        'if you need to actual select the range (which is rare in VBA)
        Application.GoTo rng3
    Else
        MsgBox "sheet is blank", vbCritical
    End If
        .Parent.Close False
    End With


     With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Upvotes: 2

PatricK
PatricK

Reputation: 6433

I think you can utilize the .UsedRange property from the Worksheet object. Try below:

Option Explicit

Function GetTrueLastCell(WS As Worksheet) As Range
    With WS
        If .UsedRange.Count = 1 Then
            Set GetTrueLastCell = .UsedRange
        Else
            Set GetTrueLastCell = .Range(Split(.UsedRange.Address, ":")(1))
        End If
    End With
End Function

Upvotes: 0

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96781

UsedRange may be erroneous, (it may be too large), but we can start with its outer limits and work inwards:

Sub TrueLastCell()
    Dim lr As Long, lc As Long, i As Long
    Dim wf As WorksheetFunction
    Set wf = Application.WorksheetFunction

    ActiveSheet.UsedRange
    With ActiveSheet.UsedRange
        lr = .Rows.Count + .Row - 1
        lc = .Columns.Count + .Column - 1
    End With

    For i = lr To 1 Step -1
        If wf.CountA(Rows(i)) <> 0 Then
            Exit For
        End If
    Next i

    For i = lc To 1 Step -1
        If wf.CountA(Cells(lr, i)) <> 0 Then
            MsgBox "The TRUE last cell is " & Cells(lr, i).Address(0, 0)
            Exit Sub
        End If
    Next i
End Sub

enter image description here

Upvotes: 4

Related Questions