Excel Ranges: Finding the Last Cell in a Range

Got any Excel/VBA Questions? 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>Alland 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: Find & Return The Last Used Cell On An Excel Worksheet Or Column VBA Function

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: Find and return the last used cell on an excel worksheet or column VBA function

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

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, e.g.: 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