Title:Excel UsedRange correction
Author:Mark Kiehl
Category:MS Excel
Sub FixUsedRange(ByVal lCol As Long)
'***********************************************************
' Finding the last empty (unpopulated) row in a column is
' a frequent task. The fastest method is to use the Excel
' property UsedRange.
' ActiveSheet.UsedRange.Rows.Count
'
' The UsedRange reported by Excel can be incorrect when you
' clear out data in rows. The function corrects the UsedRange
' reported by Excel.
'***********************************************************
'
'lCol is the column number with contiguous row data
Dim lLastDataRow As Long, lLastUsedRow As Long, lRow As Long

lLastUsedRow = ActiveSheet.UsedRange.Rows.Count

lLastDataRow = CLng(SF_splitRight(SF_remove(ActiveSheet.Cells(Rows.Count, lCol).End(xlUp).Address, "$"), "$"))

'MsgBox "Last used row is " & Str(lLastUsedRow) & ", last data row is " & Str(lLastDataRow)

If lLastUsedRow > lLastDataRow Then
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False 'really speeds it up!
For lRow = lLastUsedRow To lLastDataRow + 1 Step -1
Application.StatusBar = "Reseting contiguous used row range from " & Str(lLastUsedRow) & " to actual last empty cell of " & Str(lLastDataRow) & " ... " & Str(Int((lLastUsedRow - lRow) / (lLastUsedRow - lLastDataRow) * 100)) & "% complete"
Rows(lRow).Delete
'Rows(lRow).Select
Next lRow
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
'MsgBox "Last used row is " & Str(ActiveSheet.UsedRange.Rows.Count)
End If
End Sub

'The function above used this string function:
Function SF_splitRight(ByVal Haystack As String, ByVal Needle As String) As String
'return right part of haystack delimited by the first occurrence of needle
'if needle is empty or not found, haystack is returned
'if haystack ends with needle (or is equal to needle), a zero-length string is returned
'SF_splitRight(" This is my string "," my s") returns "tring "
Dim i As Long
If SF_isNothing(Needle) Then
SF_splitRight = Haystack
Else
i = InStr(1, Haystack, Needle, vbBinaryCompare)
If i = 0 Then
SF_splitRight = Haystack
Else
SF_splitRight = Mid(Haystack, i + Len(Needle))
End If
End If
End Function

Function SF_isNothing(ByVal Haystack As String) As Boolean
'check if there is anything in a string (to avoid testing for
'isnull, isempty, and zero-length strings)
'SF_isNothing(" This is my string ") returns False
If Haystack & "" = "" Then
SF_isNothing = True
Else
SF_isNothing = False
End If
End Function