Option Explicit
Option Base 1
'**********************************************************************
'*Excel 2003 VBA Programmer's Reference by Kimmel, Paul/ Bullen, Stephen (Google Affiliate Ad)
'**********************************************************************
'* Programmed by YouTube User:
'* vb4excel
'*
'* Final Row Locator
'* Class Module: v0.4a
'**********************************************************************
'*Microsoft Excel 2000 Power Programming with VBA [With CDROM] by Walken (Google Affiliate Ad)
'**********************************************************************
'* Version 0.4a Notes
'* Feature Updates:
'* -Diagnostics_Run
'* Diagnostics displays a Message Box with the individual
'* methods' results returned for the Fina Row location.
'* -Para (This method attempts to retrevie the lowest row number found)
'* if the highest row number can not be verified.
'* -DoubleCheck
'* -Compares 2 values for a match and returns true or false
'* -Verify
'* -Determins the highest row number in a democratic manner.
'* Bug Fixes:
'* -None
'*
'**********************************************************************
'* 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 Property Get FinalRow(Optional ByVal Col As String, Optional ByVal Min As Boolean) As Long
FinalRow = pFinalRow(Col, Min)
End Property
Public Property Get Verify(Optional ByVal Col As String, Optional ByVal Min As Boolean) As Long
Verify = pVerify(Col, Min)
End Property
Private Function pVerify(Optional ByVal Col As String, Optional ByVal Min As Boolean) As Long
Dim i As Long
Dim j As Long
Dim rVerify As Long
Dim Votes(1 To 5) As Byte
Dim Congress(1 To 5) As Long
Dim FRL As New FinalRowLocator
Congress(1) = FRL.Columbus
Congress(2) = FRL.GosEgg
Congress(3) = FRL.OldTimer
Congress(4) = FRL.RainMan
Congress(5) = FRL.Slacker
For i = 1 To 5
For j = 1 To 5
If Congress(i) = Congress(j) Then Votes(i) = Votes(i) + 1
Next j
Next i
For i = 1 To 5
If rVerify < Congress(i) Then rVerify = i
Next i
pVerify = Congress(rVerify)
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
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
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)
Case True
If pFinalRow_M1(Col) < FinalRow Then FinalRow = pFinalRow_M1(Col)
If pFinalRow_M2(Col) < FinalRow Then FinalRow = pFinalRow_M2(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) _
& "OldTimer: " & FRL.OldTimer & Chr(13) _
& "RainMan: " & FRL.RainMan & Chr(13) _
& "Slacker: " & FRL.Slacker '& _
' _ & "MathIt: " & FRL.MathIt & Chr(13)
End Function
Public Property Get DoubleCheck(ByVal Result1 As Long, ByVal Result2 As Long) As Boolean
If Result1 <> Result2 Then DoubleCheck = False
If Result1 = Result2 Then DoubleCheck = True
End Property
Private Property Get pPara()
Dim FRL As New FinalRowLocator
pPara = FRL.FinalRow(, Not FRL.DoubleCheck(FRL.FinalRow, FRL.Verify))
End Property
Public Property Get Para()
Para = pPara
End Property
No comments:
Post a Comment