View Single Post
  #15   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert RB Smissaert is offline
external usenet poster
 
Posts: 2,452
Default Getting data from a closed wbook

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" wrote in message
...
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)
0 Then within the Do While Loop.

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

"RB Smissaert" wrote:

Try this code:


Sub test()

MsgBox GetXLRows("C:\ExcelFiles\", "Test.xls", "Sheet1")

End Sub