Excel / VBA last row/column

Question

I need to copy paste big sheets, this is taking a lots of time. I have been advised not to use .copy process on worksheets but rather proceeds cell by cell. Giving new cells each properties of the ancient cell. This is what I do here: Saving only some sheets in another Workbook.

To do it cells by cells I need to know the last cell containing information. (not only value, but colour, borders... etc). I've seen many simple solution on internet, but they all have a problem.

ActiveSheet.UsedRange.Rows.Count often gives too many values... I got a 810 * 16000 answer for a 5 * 18 table

range("A" & activesheet.rows.count).end(xlup).row works only for the first columns...

What would be the best way to procedd to final the real last line with value ? containig information (value, colour, border...)

Answer 1

This command in Excel 2010 ActiveCell.SpecialCells(xlLastCell).Select will move the cursor (active cell) to the last one that had a non-trivial value, even if the cell currently is blank

This command Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select will select all cells from the current to the last one that had a non-trivial value.

Answer 2

Both these approaches work for me for getting the last cell 2007. I have used the "UsedRange" method in Excel 2003 as well.

If they do not work for you then your spreadsheet may have something in it that Excel is not showing you. This has happened to me before. The fix would be to select every empty row below your real data and right-Click->Delete them (Same with columns to the right).

Shortcut to delete rows: Shift+Space, Shift+Control+DownArrow, Rightclick->Delete

Shortcut to delete columns: Control+Space, Shift+Control+RightArrow, Rightclick->Delete

examples:

set lastCell = ActiveCell.SpecialCells(xlLastCell)

or

Set lastCell = worksheetObj.UsedRange.Item(worksheetObj.UsedRange.Cells.Count)

Answer 3

Save the Following code to a class file name FinalRowLocator

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 

then:

Dim FLR as new FinalRowLocator
Dim FinalRow as Long
    FinalRow = FRL.FinalRow

Provided you have ascertained the correct finalrow, the following should work.

'This will return the column letter
'This Function is dependant on FinalRow returning the correct value.
Dim rInt As Long
    rInt = ActiveSheet.UsedRange.Count
    psFinalCol = Chr((rInt / FinalRow) + 64)

'This will return the column number
'This Function is dependant on FinalRow returning the correct value.
Dim rInt As Long
    rInt = ActiveSheet.UsedRange.Count
    piFinalCol = rInt / FinalRow

Additional Usage Information:

Dim FRL as New FinalRowLocator 'Create an instance of the FinalRowLocator Class
Dim FinalRow as Long 'Declare the FinalRow Variable as Long

FinalRow = FRL.FinalRow 'Gets the Highest Number returned from all methods
FinalRow = FRL.FinalRow("", true) 'Returns the lowest number from all methods
FinalRow = FLR.FinalRow("A") 'Gets the highest number (column A) returned from methods 1 & 2
FinalRow = FRL.FinalRow("A", true) 'Gets the lowest number (column A) returned from methods 1 & 2
'FRL.DoubleCheck(FRL.FinalRow, FRL.Verify) 'returns true or false based on if the values match
FinalRow.Para is the same as FRL.FinalRow(, Not FRL.DoubleCheck(FRL.FinalRow, FRL.Verify)) 'Returns the lowest row number if the highest one can not be verified.
'FRL.Verify Determins the FinalRow in a Democratic Manner.
FRL.Diagnostics 'will display the results of each individual method in a msgbox
'***** Methods
FRL.Columbus 'Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row 'May have problems with hidden rows 'This Method returns 0 on a sheet with no data while the others return 1
FRL.GosEgg 'does not count past 65536 rows [Range(ColLtr & "65536").End(xlUp).Row]
FRL.OldTimer 'Selection.SpecialCells(xlCellTypeLastCell).Select [Works on Unmodified Saved Sheet Only]
FRL.RainMain 'Cells(ActiveSheet.Rows.Count, Col).End(xlUp).Row
FRL.Slacker 'Sheets(ActiveSheet.Name).Cells(Rows.Count, ColLtr).End(xlUp).Row