This is some further optimized code plus added a timer and logging for
testing.
It works quite fast with me, but this is Excel 2003 and you might be on
2007.
Also bear in mind that you can make it a lot faster if you limit the last
column and you
may know that or you may find that with a procedure with the same
principle or you
could even combine a search for the last row with a search for the last
column.
A really fast way to do this possibly is to work directly on the BIFF
Excel file data and another option
is to capture all the data with ADO into an array and then do a binary
search (similar as in my code)
on that array.
Option Explicit
Private lStartTime As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Sub test()
Dim LR As Long
Dim lCycles As Long
Dim bLog As Boolean
'bLog = True
If bLog Then
Cells.Clear
End If
StartSW
LR = GetLastDataRow("C:\ExcelFiles\", "Lottery.xls", "Sheet1", _
, 23, , , lCycles, bLog)
StopSW , "last data row: " & LR & ", " & "found with " & lCycles & "
cycles"
End Sub
Function GetLastDataRow(strPath As String, _
strFile As String, _
strSheet As String, _
Optional lMinColumn As Long = 1, _
Optional lMaxColumn As Long = 256, _
Optional lMinRow As Long = 1, _
Optional lMaxRow As Long = 65536, _
Optional lCycles As Long, _
Optional bLogToSheet As Boolean) As Long
Dim lOldMinRow As Long
Dim lOldMaxRow As Long
Dim strArgStart As String
Dim strArg As String
Dim bPreviousFound As Boolean
On Error GoTo ERROROUT
If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
If bFileExists(strPath & strFile) = False Then
GetLastDataRow = -1
Exit Function
End If
'first check if very last row has data to do an early exit
'---------------------------------------------------------
strArgStart = "COUNTA('" & strPath & "[" & strFile & "]" & strSheet &
"'!"
strArg = strArgStart & _
"R" & lMaxRow & "C" & lMinColumn & _
":R" & lMaxRow & "C" & lMaxColumn & ")"
If ExecuteExcel4Macro(strArg) > 0 Then
GetLastDataRow = lMaxRow
Exit Function
End If
lMaxRow = lMaxRow - 1 'as this was checked above
lOldMinRow = lMinRow
lOldMaxRow = lMaxRow
Do While lMaxRow > lMinRow
strArg = strArgStart & _
"R" & lMinRow & "C" & lMinColumn & _
":R" & lMaxRow & "C" & lMaxColumn & ")"
If bLogToSheet Then
'for testing
'-----------
Cells(lCycles + 1, 1) = lMinRow
Cells(lCycles + 1, 2) = lMaxRow
Cells(lCycles + 1, 3) = lOldMinRow
Cells(lCycles + 1, 4) = lOldMaxRow
Cells(lCycles + 1, 6) = lCycles
End If
If ExecuteExcel4Macro(strArg) > 0 Then
If bLogToSheet Then
Cells(lCycles + 1, 5) = "found" 'for testing
End If
lOldMinRow = lMinRow
lMinRow = (lMaxRow + lMinRow) \ 2
If lMinRow = lOldMinRow Then
GetLastDataRow = lMinRow
Exit Function
End If
bPreviousFound = True
Else 'If ExecuteExcel4Macro(strArg) > 0
If bLogToSheet Then
Cells(lCycles + 1, 5) = "nil found" 'for testing
End If
If lCycles = 0 Then
'nil found in whole range, so return zero
'----------------------------------------
Exit Function
Else
If bPreviousFound = False Then
lOldMinRow = lMinRow
lMinRow = lMaxRow
lMaxRow = lOldMaxRow
Else
lOldMaxRow = lMaxRow
lMaxRow = lMinRow
lMinRow = lOldMinRow
End If
End If
bPreviousFound = False
End If 'If ExecuteExcel4Macro(strArg) > 0
lCycles = lCycles + 1
Loop
GetLastDataRow = lMinRow
Exit Function
ERROROUT:
GetLastDataRow = -2
End Function
Function bFileExists(ByVal sFile As String) As Boolean
Dim lAttr As Long
On Error Resume Next
lAttr = GetAttr(sFile)
bFileExists = (Err.Number = 0) And ((lAttr And vbDirectory) = 0)
On Error GoTo 0
End Function
Sub StartSW()
lStartTime = timeGetTime()
End Sub
Function StopSW(Optional bMsgBox As Boolean = True, _
Optional vMessage As Variant, _
Optional lMinimumTimeToShow As Long = -1) As Variant
Dim lTime As Long
lTime = timeGetTime() - lStartTime
If lTime > lMinimumTimeToShow Then
If IsMissing(vMessage) Then
StopSW = lTime
Else
StopSW = lTime & " - " & vMessage
End If
End If
If bMsgBox Then
If lTime > lMinimumTimeToShow Then
MsgBox "Done in " & lTime & " msecs", , vMessage
End If
End If
End Function
RBS
Geoff K said:
Hi
Thank you. The method is interesting but very slow when operating on
closed
wbooks.
First I tested it on the bloated UsedRange wbook (AF50918 v S98) -
closed.
Out of curiosity I waited more than 10 minutes and gave up.
I then ran it with the wbook open - it took 0.04 seconds to return the
correct last row of 98.
Next, I ran it on another misaligned UsedRange wbook, Q1532 against real
last cell of P153.
Closed, this took 86 seconds. Opened, it took 0.01 seconds
In execution the longest step was in the line If
ExecuteExcel4Macro(strArg)
Stepping through with the bloated wbook closed, the code never moved past
the line.
So the original question remains, how can I get MATCH to return a row
number
from both numeric and text fields?
And now this supplementary one - why does MATCH, COUNTA and this method
fail
on the bloated wbook but then processes correctly if I open it.
Ah, I see you have sent another post. Many thanks but it is 02:01 here
and
I will test in the morning.
Geoff
