Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Very Slow reading excel data into an array (while opened in new xl
I have a VBA application that reads in many excel files (sometimes in the
100's), one at a time, scans them for key info, and summarizs the data in a new workbook. The routine actually doing the reading is the first one: ReadNewContract below. After about the 150th file (each usually under 40k), the macro started coming to a crawl and I noticed in Task Manager that Excel was using more and more memory (pushing 100MB). Excel was not releasing the files out of VBA Project. In a post from Tom Ogilvy, I saw that I could open the file in a new xlApp, then close it when I was done reading the data. This got rid of the memory issue but it dramatically increased the time it took to import the excel data worksheet into an array I could use. In the original code, I read the excel file into an array using this: arrMaster(r, c - LeftIndent) = ActiveSheet.Cells(r, c) I didn't need the xlApp reference because of the way I opened the workbook. In my revised code, I read the excel file into an array using this: arrMaster(r, c - LeftIndent) = xlApp.ActiveSheet.Cells(r, c) For some reason, it is just taking an incredible amount of time just to put an excel worksheet into an array. In my original code, it happened in a blink of an eye. With the "improved" code, it takes several seconds. Can anyone tell what I'm doing wrong? Is there a better way to read in the excel data? Thanks! MikeZz To make it a cut and paste for testing, I have all basic code attached. I put all the delcarations at the end so it's easier to find the code in question. Search for: '############### QUESTION HERE to find the area in question. Thanks! MikeZz Sub ReadNewContract(fileNo, arrMaster) Dim MasterFile Dim f, c, r Dim lngCount As Long Dim Master As Workbook Dim masterSht As Worksheet Dim rowsMaster, colsMaster, lastCellMaster Dim rowMax, rightCol Dim FoundIndent Dim matCount, matTotal Dim ctCellMaster Dim testRowCountMat Dim alertStat Dim tempXLFile Dim xlApp As New Excel.Application 'ADDED FOR MEMORY Dim FileString As String 'ADDED FOR MEMORY xlApp.Application.Visible = True 'ADDED FOR MEMORY '################################################# ########################################### '########### READ IN MASTER FILE '################################################# ########################################### If fileNo = 1 Or IsEmpty(fileLocExcel) Then fileLocExcel = Get_File_Info(arrFiles(fileNo, colFileName), "Directory") End If FileString = arrFiles(fileNo, colFileName) 'ADDED FOR MEMORY xlApp.Workbooks.Open (FileString) 'Focus is now on the workbook 'ADDED FOR MEMORY 'Workbooks.Open (arrFiles(fileNo, colFileName)) Set Master = xlApp.ActiveWorkbook Set masterSht = xlApp.ActiveSheet MasterFile = Master.Name lastCellMaster = LastCellIn(masterSht) rowsMaster = LastRowIn(masterSht) arrFiles(fileNo, colFileRows) = rowsMaster colsMaster = LastColIn(masterSht) If rowsMaster = Empty Or colsMaster = Empty Then Exit Sub End If ctCellMaster = 0 ReDim arrMaster(0) ReDim arrMaster(1 To rowsMaster, 0 To colsMaster) For r = 1 To rowsMaster LeftIndent = 0 FoundIndent = False rightCol = 0 For c = 1 To colsMaster '################################################# #################### '############### QUESTION HERE ########################### ' ' "xlApp.ActiveSheet.Cells(r, c)" seems to run magnitudes slower than using ' ActiveSheet.Cells(r, c) on a regular active sheet ' in original application instance. ' Is there another way? '################################################# #################### '################################################# #################### If alignLeft = True And FoundIndent = False And Len(xlApp.ActiveSheet.Cells(r, c)) = 0 Then LeftIndent = LeftIndent + 1: GoTo nextMc End If FoundIndent = True arrMaster(r, c - LeftIndent) = xlApp.ActiveSheet.Cells(r, c) If Len(arrMaster(r, c - LeftIndent)) < 0 Then rightCol = c - LeftIndent nextMc: Next c arrMaster(r, 0) = rightCol Next r Master.Close SaveChanges:=False Set masterSht = Nothing Set Master = Nothing xlApp.Quit Set xlApp = Nothing 'ADDED FOR MEMORY End Sub Private Sub Get_File_List() Dim lngCount Dim maxcols Call Initialize_Values maxcols = colFileMaxx With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show fileCount = .SelectedItems.Count ReDim arrFiles(0) ReDim arrFiles(0 To .SelectedItems.Count, 1 To maxcols) ' Display paths of each file selected If fileCount = 0 Then End For lngCount = 1 To fileCount arrFiles(lngCount, colFileName) = .SelectedItems(lngCount) Next lngCount End With Dim f For f = 1 To fileCount Call ReadNewContract(f, arrImport) Next f End Sub Private Sub Initialize_Values() Dim col0, r ScanTime = Format(Now, "Medium Time") dateSummaryFormat = Control.Range("dateSummaryFormat") Select Case dateSummaryFormat Case "yyyy-mm-dd" ScanDate = Format(Date, dateSummaryFormat) Case "dd-mmm-yy" ScanDate = Format(Date, dateSummaryFormat) Case "yyyy-ww-ddd" ScanDate = Format(Date, dateSummaryFormat) Case Else ScanDate = Format(Date, "Medium Time") End Select 'AutoSaveFile = "x" & ScanDate & "Contracts Scanned " & " " & Replace(ScanTime, ":", "_") & ".xls" AutoSaveFile = ScanDate & "Contracts Scanned " & " " & Replace(ScanTime, ":", "_") & ".xls" fileCount = 0 completeCount = 0 col0 = 1 colFileName = col0: col0 = col0 + 1 'Filename colFileStat = col0: col0 = col0 + 1 'Scan Status colFileCust = col0: col0 = col0 + 1 colFileType = col0: col0 = col0 + 1 'Contract Type - Part, Tooling, etc colFileProd = col0: col0 = col0 + 1 'Contract Part Product Area AB/SB/SW/EL colFilePro2 = col0: col0 = col0 + 1 colFileProj = col0: col0 = col0 + 1 'Contract ALV Project Number colFileDesc = col0: col0 = col0 + 1 'Contract Part Description colFilePNum = col0: col0 = col0 + 1 'Contract Part Number colFileLNum = col0: col0 = col0 + 1 'Contract Less Finish Part Number colFileCNum = col0: col0 = col0 + 1 'Contract Number colFileRevs = col0: col0 = col0 + 1 'Contract Revision colFileDate = col0: col0 = col0 + 1 'Contract Date colFileReas = col0: col0 = col0 + 1 'Contract Amendment Reason colFileESOP = col0: col0 = col0 + 1 'Contract Effective Start Date colFileEEOP = col0: col0 = col0 + 1 'Contract Effective End Date colFilePeri = col0: col0 = col0 + 1 'Price Periods colFilePric = col0: col0 = col0 + 1 'Starting Price colFileLTAs = col0: col0 = col0 + 1 'LTA %= col0: col0 = col0 + 1 's colFilePri2 = col0: col0 = col0 + 1 'Ending Price (part contracts) colFileCurr = col0: col0 = col0 + 1 'Currency Type - First colFileCurX = col0: col0 = col0 + 1 'Currency Type - Change to colFilePack = col0: col0 = col0 + 1 'Packaging Type - First colFilePacX = col0: col0 = col0 + 1 'Packaging Type - Change to colFileCapa = col0: col0 = col0 + 1 'Starting Price colFileCap2 = col0: col0 = col0 + 1 'Ending Price (part contracts) colFileHPDa = col0: col0 = col0 + 1 'Hours Per Day - First colFileHPDX = col0: col0 = col0 + 1 'Hours Per Day - Change to colFileDunM = col0: col0 = col0 + 1 'Contract Mfg Dunns Code colFileDDun = col0: col0 = col0 + 1 'Delivery To Duns - First colFileDDuX = col0: col0 = col0 + 1 'Delivery To Duns - Change to colFileSDun = col0: col0 = col0 + 1 'Ship From Duns - First colFileSDuX = col0: col0 = col0 + 1 'Ship From Duns - Change to colFileTFre = col0: col0 = col0 + 1 'Terms Start - Freight colFileTFrX = col0: col0 = col0 + 1 'Terms Ending - Freight colFileTPay = col0: col0 = col0 + 1 'Terms Start - Payment colFileTPaX = col0: col0 = col0 + 1 'Terms Ending - Payment colFileTDel = col0: col0 = col0 + 1 'Terms Start - Delivery colFileTDeX = col0: col0 = col0 + 1 'Terms Ending - Delivery colFileBuyr = col0: col0 = col0 + 1 'Contract Buyer Name colFileHead = col0: col0 = col0 + 1 'Contract Header colFileDown = col0: col0 = col0 + 1 'Contract Download Date colFileSNam = col0: col0 = col0 + 1 'Contract Sheet Name colFileRows = col0: col0 = col0 + 1 'Contract Effective End Date colFileNam2 = col0: col0 = col0 + 1 'New Smart File Name colFileKeys = col0: col0 = col0 + 1 'Contract Key - Part English, Part Mexico, Tooling English etc.. colFileMaxx = col0 + 5 col0 = 0 colKeyDeffName = col0 + 1 'Key Definition: Name colKeyDeffCust = colKeyDeffName + 1 'Key Definition: OEM colKeyDeffType = colKeyDeffCust + 1 'Key Definition: Contract Type colKeyDeffLang = colKeyDeffType + 1 'Key Definition: Language colKeyDeffIden = colKeyDeffLang + 1 'Key Definition: Unique Identifier String used to deterime which key to use colKeyDeffSNum = colKeyDeffIden + 1 'Key Definition: Key Sheet Number colKeyDeffIMxR = colKeyDeffSNum + 1 'Key Definition: colKeyDeffIMxC = colKeyDeffIMxR + 1 'Key Definition: colKeyDeffITyp = colKeyDeffIMxC + 1 'Key Definition: colKeyDeffSNam = colKeyDeffITyp + 1 'Key Definition: Key Sheet Name colKeyDeffMaxx = colKeyDeffSNam + 5 col0 = 0 colKeyAnchName = col0 + 1 'Key Anchor: Name colKeyAnchStri = colKeyAnchName + 1 'Key Anchor: Search String (which defines location) colKeyAnchType = colKeyAnchStri + 1 'Key Anchor: Match Type (Full, Partial Match) colKeyAnchStar = colKeyAnchType + 1 'Key Anchor: Start Location in File (Top, Previous Key, Bottom) colKeyAnchDire = colKeyAnchStar + 1 'Key Anchor: Search Direction from Start (Down, Up) colKeyAnchLoca = colKeyAnchDire + 1 'Key Anchor: Row Location (Left, Right, Any) colKeyAnchFunc = colKeyAnchLoca + 1 'Key Anchor: Special Function to perform (such as count repeats) colKeyAnchRowX = colKeyAnchFunc + 1 'Key Anchor: Row in current file where this Anchor is found colKeyAnchColY = colKeyAnchRowX + 1 'Key Anchor: Col in current file where this Anchor is found colKeyAnchMaxx = colKeyAnchColY + 5 colKeyAnchStat = colKeyAnchMaxx colKeyAnchFSta = colKeyAnchStat - 1 'Key Anchor: Status of Anchor Function col0 = 0 colKeyCodeCode = col0 + 1 'Key Code: Code colKeyCodeDesc = colKeyCodeCode + 1 'Key Code: Description of search: colKeyCodeStri = colKeyCodeDesc + 1 'Key Code: Search String (which defines location) colKeyCodeStar = colKeyCodeStri + 1 'Key Code: Start Location in File (Top, Previous Key, Bottom) colKeyCodeType = colKeyCodeStar + 1 'Key Code: Match Type (Full, Partial Match) colKeyCodeDirS = colKeyCodeType + 1 'Key Code: Direction from Start to find Key Text String colKeyCodeDirA = colKeyCodeDirS + 1 'Key Code: Direction from Key Test String to find Answer colKeyCodeLook = colKeyCodeDirA + 1 'Key Code: Look Location to from Key String to find answer (next value, last value in row) colKeyCodeComm = colKeyCodeLook + 1 'Key Code: Command to perform colKeyCodeFunc = colKeyCodeComm + 1 'Key Code: colKeyCodePRng = colKeyCodeFunc + 1 'Key Code: Paste Range in contract summary worksheet colKeyCodeORig = colKeyCodePRng + 1 'Key Code: Column offset from paste range in summary sheet to put value. colKeyCodeODwn = colKeyCodeORig + 1 'Key Code: Row offset from paste range in summary sheet to put value. colKeyCodeMaxx = colKeyCodeODwn + 5 'Key Code: colKeyCodeStat = colKeyCodeMaxx colKeyCodeAnsw = colKeyCodeStat - 1 'Key Code: Result / Answer Field alignLeft = Control.Range("alignLeft").Value CreateNewWB = Control.Range("CreateNewWB").Value fileSmart = Control.Range("fileSmart") fileBackup = Control.Range("fileBackup") fileSort = Control.Range("fileSort") fileDelete = Control.Range("fileDelete") fileLocUnscanned = Control.Range("fileLocUnscanned") fileLocBackup = Control.Range("fileLocBackup") fileLocPDF = Control.Range("fileLocPDF") fileLocAuto = Control.Range("fileLocAuto") 'AutoSaveFile fileLocScanned = Control.Range("fileLocScanned") fileLocExcel = Empty 'This is determined when opening the first excel contract. fileDelPDF = Control.Range("fileDelPDF") typeConfirm = Control.Range("typeConfirm") fileKeywordScan = Control.Range("fileKeywordScan") fileWorkDays = Control.Range("fileWorkDays") ctCustomers = MasterData.Range("ctCustomers") ctAmendment_Reason = MasterData.Range("ctCustomers") KeySearches = MasterData.Range("KeySearches") KeySearchRows = MasterData.Range("KeySearchRows") KeySearchCols = MasterData.Range("KeySearchCols") workbookCreated = False errCount = 0 Set shtCopy = shtHorz Set shtSummary = Nothing Set shtPaste = Nothing Set wbFinal = Nothing Set rngCat = MasterData.Range("Category") ReDim arrFileNameSetup(0) ReDim arrKeyErr(0) 'Array of Current Key Definition (Title Block) ReDim arrKeyDeff(0) 'Array of Current Key Definition (Title Block) ReDim arrKeyCode(0) ' As Variant 'Array of Current Key Code (Programming) ReDim arrKeyAnch(0) ' As Variant 'Array of Current Key Anchor Points of Refernce (Title Block) ReDim arrFiles(0) ' As Variant ReDim arrImport(0) ' As Variant ReDim arrPeriods(0) ReDim arrPerCode(0) ReDim arrHeadStr(0) ReDim arrDunsCode(0) ReDim arrProdCats(0) ReDim arrNewDuns(0) ReDim arrNewCats(0) ReDim arrKeyWords(0) ReDim arrNotes(0) ReDim arrCustomers(0) ReDim arrReasons(0) CountNewDuns = 0 CountNewCats = 0 End Sub Private Function Get_File_Info(str, Attrib) Dim BackSlash BackSlash = InStrRev(str, "\") Select Case Attrib Case "FileName" Get_File_Info = Mid(str, BackSlash + 1) Case "Directory" Get_File_Info = Left(str, BackSlash) End Select End Function Sub testy() Dim xlApp As Excel.ApplicationExcel.ApplicationExcel.Applicatio n 'ADDED FOR MEMORY Dim test 'Dim FileString As String 'ADDED FOR MEMORY 'xlApp.Application.Visible = True 'ADDED FOR MEMORY test = xlApp.ActiveWorkbook.Name End Sub Option Explicit 'DECLARATIONS HE Dim fileCount Dim completeCount Dim arrFiles() As Variant Dim fileName Dim colFileName 'Filename Dim colFileNam2 'New Filename Dim colFileCust 'Customer like Saturn or GM Dim colFileStat 'Contract Status - was it read or was the file structure not found? Use for copying. Dim colFileCNum 'Contract Number Dim colFileRevs 'Contract Revision Dim colFileDate 'Contract Date Dim colFileHead 'Contract Header Dim colFileDunM 'Contract Mfg Dunns Code Dim colFilePNum 'Contract Part Number Dim colFileLNum 'Contract Less Finish Part Number Dim colFileType 'Contract Type - Part, Tooling, etc Dim colFileKeys 'Contract Key - Part English, Part Mexico, Tooling English etc.. Dim colFileProd 'Contract Product - AB/SB/SW/EL Dim colFilePro2 'Contract Detail - RRAB/SB/SW/EL Dim colFileDown 'Contract Download Date Dim colFileDesc 'Contract Part Description Dim colFileReas 'Contract Amendment Reason Dim colFileBuyr 'Contract Buyer Name Dim colFileESOP 'Contract Effective Start Date Dim colFileEEOP 'Contract Effective End Date Dim colFileSNam 'Contract Effective End Date Dim colFileProj 'Contract Project Number Dim colFileRows 'Contract Last Row # in Excel File Dim colFilePeri 'Price Periods Dim colFilePric 'Starting Price Dim colFileLTAs 'LTA %'s Dim colFilePri2 'Ending Price (part contracts) Dim colFileCapa 'Starting Capacity Dim colFileCap2 'Ending Capacity Dim colFileTFre 'Terms Start - Freight Dim colFileTFrX 'Terms Ending - Freight Dim colFileTPay 'Terms Start - Payment Dim colFileTPaX 'Terms Ending - Payment Dim colFileTDel 'Terms Start - Delivery Dim colFileTDeX 'Terms Ending - Delivery Dim colFileDDun 'Delivery To Duns - First Dim colFileDDuX 'Delivery To Duns - Change to Dim colFileSDun 'Ship From Duns - First Dim colFileSDuX 'Ship From Duns - Change to Dim colFileHPDa 'Hours Per Day - First Dim colFileHPDX 'Hours Per Day - Change to Dim colFilePack 'Packaging Type - First Dim colFilePacX 'Packaging Type - Change to Dim colFileCurr 'Currency Type - First Dim colFileCurX 'Currency Type - Change to Dim colFileMaxx Dim arrKeyDeff() As Variant 'Array of Current Key Definition (Title Block) Dim colKeyDeffName 'Key Definition: Name Dim colKeyDeffCust 'Key Definition: OEM Dim colKeyDeffType 'Key Definition: Contract Type Dim colKeyDeffLang 'Key Definition: Language Dim colKeyDeffIden 'Key Definition: Unique Identifier String used to deterime which key to use Dim colKeyDeffIMxR 'Key Definition: Find String before this row Dim colKeyDeffIMxC 'Key Definition: Find String before this col Dim colKeyDeffIMax 'Key Definition: Max Row to search for Key Identifier Dim colKeyDeffITyp 'Key Definition: Key String Match Type (Exact, Partial, etc) Dim colKeyDeffSNum 'Key Definition: Key Sheet Number Dim colKeyDeffSNam 'Key Definition: Key Sheet Name Dim colKeyDeffMaxx Dim arrKeyAnch() As Variant 'Array of Current Key Anchor Points of Refernce (Title Block) Dim colKeyAnchName 'Key Anchor: Name Dim colKeyAnchStri 'Key Anchor: Search String (which defines location) Dim colKeyAnchType 'Key Anchor: Match Type (Full, Partial Match) Dim colKeyAnchStar 'Key Anchor: Start Location in File (Top, Previous Key, Bottom) Dim colKeyAnchDire 'Key Anchor: Search Direction from Start (Down, Up) Dim colKeyAnchLoca 'Key Anchor: Row Location (Left, Right, Any) Dim colKeyAnchFunc 'Key Anchor: Special Function to perform (such as count repeats) Dim colKeyAnchRowX 'Key Anchor: Row in current file where this Anchor is found Dim colKeyAnchColY 'Key Anchor: Col in current file where this Anchor is found Dim colKeyAnchMaxx 'Key Anchor: Col in current file where this Anchor is found Dim colKeyAnchFSta 'Key Anchor: Status of Anchor Point Dim colKeyAnchStat 'Key Anchor: Status of Anchor Point Const rowKeyAnchMaxx = 20 'Key Anchor: Max possible Key Anchor Points for all Keys Dim arrKeyCode() As Variant 'Array of Current Key Code (Programming) Dim colKeyCodeCode 'Key Code: Code Dim colKeyCodeDesc 'Key Code: Description of search: Dim colKeyCodeStri 'Key Code: Search String (which defines location) Dim colKeyCodeStar 'Key Code: Start Location in File (Top, Previous Key, Bottom) Dim colKeyCodeType 'Key Code: Match Type (Full, Partial Match) Dim colKeyCodeDirS 'Key Code: Direction from Start to find Key Text String Dim colKeyCodeDirA 'Key Code: Direction from Key Test String to find Answer Dim colKeyCodeLook 'Key Code: Look Location to from Key String to find answer (next value, last value in row) Dim colKeyCodeComm 'Key Code: Command to perform - Such as Loop Dim colKeyCodeFunc 'Key Code: Function to perform on Value such as Add ALV loc to Duns Code Dim colKeyCodePRng 'Key Code: Paste Range in contract summary worksheet Dim colKeyCodeORig 'Key Code: Column offset from paste range in summary sheet to put value. Dim colKeyCodeODwn 'Key Code: Row offset from paste range in summary sheet to put value. Dim colKeyCodeAnsw 'Key Code: Dim colKeyCodeMaxx 'Key Code: Dim colKeyCodeStat 'Key Code: Dim arrErrors() As Variant Const colKeyErrFile = 1 'KeyErr Anchor: Name Const colKeyErrCode = 2 'KeyErr Anchor: Anchor or Code Const colKeyErrDesc = 3 'KeyErr Anchor: Name Const colKeyErrStri = 4 'KeyErr Anchor: Search String (which defines location) Const colKeyErrStar = 5 'KeyErr Anchor: Start Location in File (Top, Previous KeyErr, Bottom) Const colKeyErrType = 6 'KeyErr Anchor: Search Direction from Start (Down, Up) Const colKeyErrDir1 = 7 'KeyErr Anchor: Row Location (Left, Right, Any) Const colKeyErrDir2 = 8 'KeyErr Anchor: Special Function to perform (such as count repeats) Const colKeyErrRowX = 9 'KeyErr Anchor: Special Function to perform (such as count repeats) Const colKeyErrColY = 10 'KeyErr Anchor: Special Function to perform (such as count repeats) Const colKeyErrRang = 11 'KeyErr Anchor: Special Function to perform (such as count repeats) Const colKeyErrStat = 12 'KeyErr Anchor: Special Function to perform (such as count repeats) Const colKeyErrMaxC = 20 'KeyErr Anchor: Special Function to perform (such as count repeats) Const colKeyErrMaxR = 20000 'KeyErr Anchor: Special Function to perform (such as count repeats) Dim errCount Const rowKeyCodeMaxx = 100 'Key Code: Max possible Key Code Points for all Keys Dim LeftIndent Dim alignLeft Dim CreateNewWB Dim shtCopy As Worksheet Dim shtSummary As Worksheet Dim shtPaste As Worksheet Dim Check_For_Periods Dim period_Count, period_Items Dim wbFinal As Workbook Dim KeyCount 'Number of Key Formats Dim arrImport() As Variant Dim arrPeriods() As Variant Dim arrPerCode() As Variant Dim arrHeadStr() As Variant Dim arrDunsCode() As Variant Dim arrProdCats() As Variant Dim arrNewDuns() As Variant Dim arrNewCats() As Variant Dim arrKeyWords() As Variant Dim arrCustomers() As Variant Dim ctCustomers Dim KeySearches, KeySearchRows, KeySearchCols Dim arrReasons() As Variant Dim ctAmendment_Reason Dim arrNotes() As Variant Dim CountNewDuns Dim CountNewCats Dim workbookCreated Dim arrFileNameSetup() As Variant Dim fileSmart Dim fileBackup Dim fileSort Dim fileDelete Dim fileDelPDF Dim fileLocUnscanned Dim fileLocBackup Dim fileLocPDF Dim fileLocScanned Dim fileLocAuto Dim fileLocExcel Dim fileWorkDays Dim typeConfirm Dim fileKeywordScan Dim rngCat As Range Dim ScanTime Dim ScanDate Dim AutoSaveFile Dim dateSummaryFormat |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Reading current opened Excel book(file) into streams | Excel Programming | |||
Why Excel files opened from Explorer are slow - MVP response pleas | Excel Discussion (Misc queries) | |||
MY ARRAY FORMULA IS SLOW IF DATA LIST IS MORE THAN 10000R0WS | Excel Programming | |||
Reading from a excel sheet to an array | Excel Programming | |||
[excel 97 vba ] Reading ranges into an array | Excel Programming |