Option Explicit
Option Base 1
'**********************************************************************
'*Introduction to VBA for Excel (2nd Edition) by Chapra, Steven C. [Pape (Google Affiliate Ad)
'**********************************************************************
'* Programmed by YouTube User:
'* vb4excel
'*
'* Locate Final Row
'* Class Module: v0.3.1a
'*
'* 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.
'*
'**********************************************************************
'*Writing Excel Macros with VBA (2nd Edition) by Roman, Steven [Paperbac (Google Affiliate Ad)
'**********************************************************************
'* Version 0.3.1a Notes
'* Feature Updates:
'* -Disabled MathIt Method
'* Bug Fixes:
'* -Disabled MathIt Method. Reason:Current Forumula Returns
'* the last column causing the primary final row function
'* to fail if more columns than rows are present.
'* (This will be corrected in a later version.)
'*
'**********************************************************************
'* Version 0.3a Notes
'* Feature Updates:
'* -Added Public Named Objects to be used for calling
'* each method individually.
'* 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 Function FinalRow(Optional ByVal Col As String, Optional ByVal Min As Boolean) As Long
FinalRow = pFinalRow(Col, Min)
End Function
Public Property Get GosEgg(Optional ByVal Col As String) As Long
GosEgg = pFinalRow_M1(Col)
End Property
Public Property Get RainMan(Optional ByVal Col As String) As Long
RainMan = pFinalRow_M2(Col)
End Property
'Public Property Get MathIt() As Long
' MathIt = pFinalRow_M3
'End Property
Public Property Get OldTimer() As Long
OldTimer = pFinalRow_M4
End Property
Public Property Get Columbus() As Long
Columbus = pFinalRow_M5
End Property
Public Property Get Slacker(Optional ByVal Col As Long) As Long
Slacker = pFinalRow_M6(Col)
End Property
Private Function pFinalRow(Optional ByVal Col As String, Optional ByVal 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
If pFinalRow_M7 > FinalRow Then FinalRow = pFinalRow_M7
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
If pFinalRow_M7 < FinalRow Then FinalRow = pFinalRow_M7
End Select
Case Is <> 0
Select Case Min
Case False
If pFinalRow_M1(Col) > FinalRow Then FinalRow = pFinalRow_M1(Col)
If pFinalRow_M2(Col) > FinalRow Then FinalRow = pFinalRow_M2(Col)
If pFinalRow_M7(Col) > FinalRow Then FinalRow = pFinalRow_M7(Col)
Case True
If pFinalRow_M1(Col) < FinalRow Then FinalRow = pFinalRow_M1(Col)
If pFinalRow_M2(Col) < FinalRow Then FinalRow = pFinalRow_M2(Col)
If pFinalRow_M7(Col) < FinalRow Then FinalRow = pFinalRow_M7(Col)
End Select
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
Public Function Diagnostics_Run()
Dim FRL As New FinalRowLocator
MsgBox "Columbus: " & FRL.Columbus & Chr(13) _
& "FinalRow: " & FRL.FinalRow & Chr(13) _
& "GosEgg: " & FRL.GosEgg & Chr(13) _
& "MathIt: " & FRL.MathIt & Chr(13) _
& "OldTimer: " & FRL.OldTimer & Chr(13) _
& "RainMan: " & FRL.RainMan & Chr(13) _
& "Slacker: " & FRL.Slacker
End Function
No comments:
Post a Comment