Thursday, January 5, 2012

Excel VBA Class Module Final Row Locator


Option Explicit
Option Base 1
'**********************************************************************
'*VBA and Macros: Microsoft Excel 2010 by Jelen, Bill/ Syrstad, Tracy [P (Google Affiliate Ad)
'**********************************************************************
'* Programmed by YouTube User:
'*      vb4excel
'*
'* FinalRowLocator
'* Class Module: v0.3a
'*
'* 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.
'*
'**********************************************************************
'*VBA and Macros for Microsoft Office Excel 2007 by Jelen, Bill/ Syrstad (Google Affiliate Ad)
'**********************************************************************
'*  Version 0.3a Notes
'*      Feature Updates:
'*          -Added Public Named Objects to be used for calling
'*              each method individually.
'*          -Name changed from Ascertain to FinalRowLocator
'*      Bug Fixes:
'*          -None
'*
'**********************************************************************
'*  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 Property Get Finalrow(Optional ByVal Col As String, Optional Min As Boolean) As Long
    Finalrow = pFinalRow(Col, Min)
End Property

Public Function GosEgg(Optional Col As String) As Long
    GosEgg = pFinalRow_M1(Col)
End Function

Public Function RainMan(Optional Col As String) As Long
    RainMan = pFinalRow_M2(Col)
End Function

Public Function MathIt() As Long
    MathIt = pFinalRow_M3
End Function

Public Function OldTimer() As Long
    OldTimer = pFinalRow_M4
End Function

Public Function Columbus() As Long
    Columbus = pFinalRow_M5
End Function

Public Function Slacker(Optional Col As Long) As Long
    Slacker = pFinalRow_M6(Col)
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