Excel Ranges: Finding the Last Cell in a Range

NEW! More Books..

Add Excel Answers & Search To Your Google Toolbar Details

Current Special! Complete Excel Excel Training Course for Excel 97 - Excel 2003, only ~~$145.00~~. $59.95 Instant Buy/Download, 30 Day Money Back Guarantee & Free Excel Help for LIFE!

Back to: Excel VBA . Got any Excel/VBA Questions? Free Excel Help

Find the last used cell, before a blank in a Column:
Sub LastCellBeforeBlankInColumn()
Range("A1").End(xldown).Select
End Sub

Find the very last used cell in a Column:
Sub LastCellInColumn()
Range("A65536").End(xlup).Select
End Sub

Find the last cell, before a blank in a Row:
Sub LastCellBeforeBlankInRow()
Range("A1").End(xlToRight).Select
End Sub

Find the very last used cell in a Row:
Sub LastCellInRow()
Range("IV1").End(xlToLeft).Select
End Sub

Find the very last used cell on a Worksheet:
Sub Demo()
Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Select
End Sub

Find the last Row, Column or Cell

You can use Edit>Go to-Special-Last cell to try and find the last cell in the active sheet, but it is not very reliable. The reasons are two-fold:

1. The last cell is only re-set when you save. This means if you enter any number or text in say, cell A10 and A20 of a new Worksheet, then delete the content of A20, the Edit>Go to-Special-Last cell will keep taking you to A20, until you save.

2. It picks up cell fomatting. Let's say you enter any text or number in cell A10 and then enter a valid date in cell A20 of a new Worksheet. Now delete the date in cell A20 and save. The Edit>Go to-Special-Last cell will still take you to A20. This is because entering a date in A20 has caused Excel to automatically format the cell from "General" to a Date format. To stop from going to A20 you will have to use Edit>Clear>All and then save.

So when using VBA you cannot rely on:

Range("A1").SpecialCells(xlCellTypeLastCell).Select

Below are three methods that will find the "LastRow", "LastColumn" and the "LastCell"

Find the last used Row on a Worksheet:

Sub FindLastRow()
Dim LastRow As Long
	If WorksheetFunction.CountA(Cells) > 0 Then
		'Search for any entry, by searching backwards by Rows.
		LastRow = Cells.Find(What:="*", After:=[A1], _
			  SearchOrder:=xlByRows, _
			  SearchDirection:=xlPrevious).Row
			  MsgBox LastRow
	End If
End Sub

Find the last used Column on a Worksheet:

Sub FindLastColumn()
Dim LastColumn As Integer
	If WorksheetFunction.CountA(Cells) > 0 Then
		'Search for any entry, by searching backwards by Columns.
		LastColumn = Cells.Find(What:="*", After:=[A1], _
        		           SearchOrder:=xlByColumns, _
        			   SearchDirection:=xlPrevious).Column
				   MsgBox LastColumn
	End If 
End Sub

Find the last used Cell on a Worksheet:

Sub FindLastCell()
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCell As Range
	If WorksheetFunction.CountA(Cells) > 0 Then
		'Search for any entry, by searching backwards by Rows.
		LastRow = Cells.Find(What:="*", After:=[A1], _
        			SearchOrder:=xlByRows, _
        			SearchDirection:=xlPrevious).Row
		'Search for any entry, by searching backwards by Columns.
				LastColumn = Cells.Find(What:="*", After:=[A1], _
        			SearchOrder:=xlByColumns, _
        			SearchDirection:=xlPrevious).Column
				MsgBox Cells(LastRow, LastColumn).Address
	End If 
End Sub

A dynamic range via VBA:

To put this code in:
While in the Excel interface, right click on the sheet picture(top left next to "File") and select "View Code". Then choose an event from the "Procedure" drop down list box. For Excel 2000 you will need to select "Workbook" from the "Object" drop down list box first.

Private Sub Workbook_BeforeSave _
               (ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim SheetName As String, NameAddress As String


	With Sheet1 ' CodeName
		'Pass Sheet1 Tab name and range A1 currentregion address.
		SheetName = "=" & .Name & "!"
		NameAddress = .Range("A1").CurrentRegion.Address
		'Add the name MyRange
		ActiveWorkbook.Names.Add _
 			 Name:="MyRange",RefersTo:=SheetName & NameAddress
	End With
End Sub

As you may or may not realise, this code will fire immediantley before the Workbook is saved. If you are unsure as to what constitutes the CurrentRegion of a cell then push F1 and type in "Curent Region".

Another method is to right click on the sheet name tab, select "View Code" and use:

Private Sub Worksheet_Calculate()
    Range("A1", Range("A65536").End(xlUp)).Name = "MyRange"
End Sub

This will define the named range "MyRange" to all data in Column A each time the Worksheet recalculates. If you need to expand across, as well as down, use:

Private Sub Worksheet_Calculate()
    Range(Range("IV1").End(xlToLeft), Range("A65536").End(xlUp)).Name = "MyRange"
End Sub

We can also use the Change Event like below:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(1)) Is Nothing Then
       Range("A1", Range("A65536").End(xlUp)).Name = "MyRange"
    End If
End Sub

Define a 1 Column range that can include blanks:

Sub OneColumnDyaRange()
Range("A1", Range("A65536").End(xlUp)).Name = "MyRange"
End Sub

Define a 1 Column range that will not include blanks:

Sub OneColumnDyaRange()
Range("A1", Range("A1").End(xlDown)).Name = "MyRange"
End Sub

Both of the above examples could be placed within the Workbook module so that they are redefined each time the Event chosen runs, eg; Workbook_BeforeSave, Workbook_Open etc.

Add a row at each change in a column

Assume you have a long list of data and you want to insert a row at each change. While you could use a simple Loop this method is much faster. The Data must be sorted!

Sub InsertRowAtEachChange()
Dim rRange As Range

'Ensure an entire Column is selected
If Selection.Cells.Count <> 65536 Then
 MsgBox "You must select an entire column", vbCritical
  End
End If

On Error Resume Next
'Set a range variable to all data in selected column
Set rRange = Range(Selection.Cells(2, 1), _
             Selection.Cells(65536, 1).End(xlUp))
            
'Add a column for formulas
With rRange
     .EntireColumn.Insert
     .Offset(0, -1).FormulaR1C1 = _
         "=IF(AND(NOT(ISNA(R[-1]C))," _
         & "R[-1]C[1]<>RC[1]),0,"""")"
    'Convert to values
     .Offset(0, -1) = .Offset(0, -1).Value
     'Set variable to 0
     Set rRange = .Offset(0, -1).SpecialCells _
               (xlCellTypeConstants, xlNumbers)
 End With
 'Add a row at each 0
 If WorksheetFunction.CountIf(rRange, 0) > 0 Then
    rRange.EntireRow.Insert
 End If
 'Reset variable for next formulas
 Set rRange = _
 Range(Selection.Cells(2, 1), _
       Selection.Cells(65536, 1).End(xlUp))

 'Add the formula to add 0
 rRange.FormulaR1C1 = _
         "=IF(OR(RC[1]="""",R[-1]C[1]=""""),""""," _
         & "IF(RC[1]<>R[-1]C[1],0))"
 'Convert to values
  rRange = rRange.Value
 'Set variable to 0 cells if any
 If WorksheetFunction.CountIf(rRange, 0) > 0 Then
    Set rRange = rRange.SpecialCells(xlCellTypeConstants, xlNumbers)

     'Add a row at each 0
     rRange.EntireRow.Insert
  End If
     'Delete added Column
     rRange.Columns(1).EntireColumn.Delete
    
On Error GoTo 0
Set rRange = Nothing
End Sub

You should Sort then select your entire column before running this code.

Transpose Columns of Data Into Rows.

If you have many columns of data that each have thousands of rows, this code will transpose them onto another sheet.

Sub TransposeThem()
Dim iRows As Long
Dim iCol As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets.Add().Name = "Trans"
On Error GoTo 0

If ActiveSheet.Name <> "Trans" Then
  ActiveSheet.Delete
  Sheets("Trans").Cells.Clear
End If

Application.DisplayAlerts = True

For iCol = 1 To Range("IV1").End(xlToLeft).Column
 For iRows = 1 To Columns(iCol).Range("A65536").End(xlUp).Row Step 256
     Columns(iCol).Range("A" & iRows _
        & ":" & "A" & iRows + 255).Copy
     Sheets("Trans").Range("A65536").End(xlUp).Offset _
       (1, 0).PasteSpecial Transpose:=True
 Next iRows
Next iCol

Application.ScreenUpdating = True
End Sub

You should select your entire column before running this code.

Marking All Absolute Formulae

This bit of code will mark all formulae on the Active sheet that use Absolute references.

Sub AbsOnly()
Dim rFormulas As Range
Dim rCell As Range
On Error Resume Next
Set rFormulas = Cells.SpecialCells(xlCellTypeFormulas)

If rFormulas Is Nothing Then
 MsgBox "No formulas found"
 On Error GoTo 0
 Exit Sub
End If

On Error GoTo 0

For Each rCell In rFormulas
If Application.ConvertFormula(Formula:=rCell.Formula, _
            FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, _
            ToAbsolute:=xlAbsolute) = rCell.Formula Then
 rCell.Font.ColorIndex = 5
End If
Next rCell

End Sub

Excel Dashboard Reports & Excel Dashboard Charts 50% Off

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to special@ozgrid.com 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft