Option Explicit Sub Reset_lastcell() 'David McRitchie, http://www.mvps.org/dmcritchie/excel/lastcell.htm Dim x As Long 'Attempt to fix the lastcell on the current worksheet x = ActiveWorksheet.UsedRange.Rows.Count 'see J-Walkenbach tip 73 End Sub Sub Reset_all_lastcells() 'David McRitchie, http://www.mvps.org/dmcritchie/excel/lastcell.htm Dim sh As Worksheet, x As Long For Each sh In ActiveWorkbook.Worksheets x = sh.UsedRange.Rows.Count 'see J-Walkenbach tip 73 Next sh End Sub Sub CleanUpLastCells() '2002-08-02 based, David McRitchie, programming ' http://www.mvps.org/dmcritchie/excel/lastcell.htm#CleanUpLastCells 'This macro will attempt to reset internals, based on a little trick 'involving usedrange.rows.count which may or may not work 'but would be nondestructive. Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.EnableEvents = False Dim xLong As Long, csht As Long For csht = 1 To ActiveWorkbook.Worksheets.Count Worksheets(csht).Select xLong = ActiveSheet.UsedRange.Rows.Count + _ ActiveSheet.UsedRange.Columns.Count 'Tip73 Next csht ActiveWorkbook.Save AbortCode: '-- one of these is only done in macros make sure you exit thru here... Application.EnableEvents = True Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Sub makelastcell() 'David McRitchie, http://www.mvps.org/dmcritchie/excel/lastcell.htm Dim x As Long 'revised 2001-08-09 to remove false indication Dim str As String 'revised 2006-07-05 for lastcell to be is a merged cell Dim xLong As Long, clong As Long, rlong As Long On Error GoTo 0 x = MsgBox("Do you want the activecell to become " & _ "the lastcell" & Chr(10) & Chr(10) & _ "Press OK to Eliminate all cells beyond " _ & ActiveCell.Address(0, 0) & Chr(10) & _ "Press CANCEL to leave sheet as it is", _ vbOKCancel + vbCritical + vbDefaultButton2) If x = vbCancel Then Exit Sub str = ActiveCell.Address Range(ActiveCell.Row + ActiveCell.MergeArea.Rows.Count & ":" & Cells.Rows.Count).Delete Range(Cells(1, ActiveCell.Column + ActiveCell.MergeArea.Columns.Count), _ Cells(Cells.Rows.Count, Cells.Columns.Count)).Delete xLong = ActiveSheet.UsedRange.Rows.Count 'see J-Walkenbach tip 73 xLong = ActiveSheet.UsedRange.Columns.Count 'might also help Beep xLong = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Columns.Count 'Tip73 rlong = Cells.SpecialCells(xlLastCell).Row clong = Cells.SpecialCells(xlLastCell).Column If rlong <= ActiveCell.Row And clong <= ActiveCell.Column Then Exit Sub ActiveWorkbook.Save xLong = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Columns.Count 'Tip73 rlong = Cells.SpecialCells(xlLastCell).Row clong = Cells.SpecialCells(xlLastCell).Column If rlong <= ActiveCell.Row And clong <= ActiveCell.Column Then Exit Sub MsgBox "Sorry, Have failed to make " & str & " your last cell, " _ & "possible merged cells involved, check your results" End Sub Sub Fix_all_lastcells() 'David McRitchie, http://www.mvps.org/dmcritchie/excel/lastcell.htm Dim sh As Worksheet, x As Long For Each sh In ActiveWorkbook.Worksheets x = sh.UsedRange.Rows.Count 'see J-Walkenbach tip 73 Next sh End Sub Sub QueryLastCells() '2001-03-25 based on BuildTOC David McRitchie, programming ' http://www.mvps.com/dmcritchie/excel/buildtoc.htm Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Dim cRow As Long, cCol As Long, csht As Long Dim lastcell Dim Testcnt As Long Dim BigString As String BigString = "" Testcnt = 5000 Testcnt = InputBox("Supply Threshhold for used cells count", _ "QueryLastCells", Testcnt) If Testcnt = 0 Then GoTo AbortCode For csht = 1 To ActiveWorkbook.Worksheets.Count Set lastcell = Worksheets(csht).Cells.SpecialCells(xlLastCell) If lastcell.Column * lastcell.Row > Testcnt Then BigString = BigString & Chr(10) & _ Format(lastcell.Column * lastcell.Row, "##,###,##0") _ & Chr(9) & " " & Worksheets(csht).Name End If Next csht MsgBox BigString & Chr(10) & "Worksheets checked: " _ & ActiveWorkbook.Worksheets.Count AbortCode: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub