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
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment