Thursday, January 5, 2012

Excel VBA Find Final 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.<br />
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 for Version 0.3a

Option Explicit
Option Base 1
'**********************************************************************
'**********************************************************************
'* Programmed by YouTube User:
'*      vb4excel
'*
'* Ascertain
'* Class Module: v0.2a
'*
'* FinalRow
'*  *Col {String}(Optional):
'*      -Default: A(1) (When Needed)
'*      -Target Specfic Column, Accepts String Input Only
'*  *Min {Bolean}(Optional):
'*      -Set to True to Return the Lowest Found Row Number.
'*      -The Default (False) Returns the Highest Found Row Number.
'*
'*  Version 0.2a Notes
'*      Feature Updates:
'*          -Switch Added to Return Lowest Row Number Found
'*      Bug Fixes:
'*          -pFinalRow_M5 now Returns 0 instead of an Error 91
'*              when no data is present on the sheet.
'*
'**********************************************************************
'**********************************************************************

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

Private Function pFinalRow(Optional ByVal Col As String, Optional Min As Boolean) As Long
    Dim FinalRow As Long
        Select Case Col
            Case Is = ""
                Select Case Min
                    Case False
                        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 True
                        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
                End Select
            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
On Error GoTo ErrorHandler
    'May have problems with hidden rows
    'This Method returns 0 on a sheet with no data while the others return 1
    pFinalRow_M5 = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Exit Function
ErrorHandler:
    Select Case Err.Number
        Case 91
            'Assume Error is due to no data, return 0
            pFinalRow_M5 = 0
            Resume Next
        Case Else
            On Error GoTo 0
    End Select
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