Home |
Search |
Today's Posts |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Getting data from a closed wbook
Also bear in mind that often you know that the only column to consider is
column 1, so in that case you can do, as in my example: LR = GetLastDataRow("C:\ExcelFiles\", "Lottery.xls", "Sheet1", _ , 1, , , lCycles, bLog) Making it a lot faster. RBS "RB Smissaert" wrote in message ... 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Get values from 15 sheets in a Wbook | Excel Programming | |||
updating wbook from other... | Excel Programming | |||
transfering data from 2 wbook | Excel Programming | |||
transfering data value from 2 Wbook... | Excel Programming | |||
Read And Write On A Closed Wbook | Excel Programming |