Wednesday, January 4, 2012

Excel VBA Find Last Row Class Module


This is the source code to a class module that attempts to ascertain the actual location of the last row on the spread sheet by using multiple methods to detected it, compare the results and determine which result is correct.
To use this, create a new class module in the Excel VBA editor and copy and paste the following code into it.  (I have named the class module Ascertain.)
Click here to get Version 0.2a Source Code

Option Explicit
Option Base 1
'**************
'* Programmed by YouTube User:
'*      vb4excel
'*
'* Ascertain
'* Class Module: v0.1a
'**************

Public Function FinalRow(Optional ByVal Col As String) As Long
    FinalRow = pFinalRow(Col)
End Function

Private Function pFinalRow(Optional ByVal Col As String) As Long
    Dim FinalRow As Long
        Select Case Col
            Case Is = ""
                If pFinalRow_M1 > pFinalRow_M2 Then FinalRow = pFinalRow_M1
                If pFinalRow_M1 < pFinalRow_M2 Then FinalRow = pFinalRow_M2
                If pFinalRow_M3 > FinalRow Then FinalRow = pFinalRow_M3
                If pFinalRow_M5 > FinalRow Then FinalRow = pFinalRow_M5
                If pFinalRow_M6 > FinalRow Then FinalRow = pFinalRow_M6
            Case Is <> 0
                If pFinalRow_M1(Col) > FinalRow Then FinalRow = pFinalRow_M1(Col)
                If pFinalRow_M2(Col) > FinalRow Then FinalRow = pFinalRow_M2(Col)
        End Select
      
        'If pFinalRow_M4 > FinalRow Then FinalRow = pFinalRow_M4 'Disabled, lags behind.
      
            pFinalRow = FinalRow
End Function

Private Function pFinalRow_M1(Optional ByRef ColLtr As String) As Long
    If ColLtr = "" Then ColLtr = "A"
    pFinalRow_M1 = Range(ColLtr & "65536").End(xlUp).Row
End Function

Private Function pFinalRow_M2(Optional ByRef Col As String) As Long
    Dim i As Byte
    Dim FinalRow As Long
    Select Case Col
        Case Is  = ""
            For i = 1 To 26
                If FinalRow < Cells(ActiveSheet.Rows.Count, i).End(xlUp).Row Then FinalRow = Cells(ActiveSheet.Rows.Count, i).End(xlUp).Row
            Next i
        Case Is <> ""
            FinalRow = Cells(ActiveSheet.Rows.Count, Col).End(xlUp).Row
    End Select
        pFinalRow_M2 = FinalRow
End Function

Private Function pFinalRow_M3() As Long
    Dim FinalRow As Long
    Dim ASUC As Long
        ASUC = ActiveSheet.UsedRange.Count
    FinalRow = ASUC / pFinalRow_M2
    pFinalRow_M3 = FinalRow
End Function

Private Function pFinalRow_M4() As Long
    'Works on unmodified (saved) sheet only.
    Selection.SpecialCells(xlCellTypeLastCell).Select
    pFinalRow_M4 = ActiveCell.Row
End Function

Private Function pFinalRow_M5() As Long
    'May have problems with hidden rows
    pFinalRow_M5 = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
End Function

Private Function pFinalRow_M6(Optional ByRef ColLtr As Long) As Long
    If ColLtr <= 0 Then ColLtr = 1
    pFinalRow_M6 = Sheets(ActiveSheet.Name).Cells(Rows.Count, ColLtr).End(xlUp).Row
End Function



No comments:

Post a Comment