By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
428,898 Members | 1,169 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 428,898 IT Pros & Developers. It's quick & easy.

Do while loop slow - optimization???

P: 1
Hi all

Been trying to optimize this loop to run faster im exporting at list 20 000 records and it goes on forever... any tios

Expand|Select|Wrap|Line Numbers
  1. Sub ExportGridToExcel()
  2.  
  3.         On Error GoTo ErrorHandler
  4.  
  5.         Dim lngColCntr As Integer
  6.         Dim strPassedString As String
  7.         Dim lngTmpVar As Integer
  8.         Dim intPrevRow As Integer
  9.         Erase arrExport
  10.         blnSomethingExported = False
  11.  
  12.         'check that to column >= to column
  13.         If (dblGridEndRow.Value < dblGridBeginRow.Value) Or (dblGridEndColumn.Value < dblGridBeginColumn.Value) Then
  14.             Call objGeneral.DisplayMessage(Qm.Enum.EnumMainFormNET.enumMessageType.msgtApplicationMessage, Qm.Enum.EnumMainFormNET.enumMessageSource.msgsDataBase, 60340, Me.Handle.ToInt32)
  15.             'End Row/Column may not be greater than Begin Row/Column.
  16.             Cursor = Cursors.Arrow
  17.             Exit Sub
  18.         End If
  19.  
  20.         'array to indicate if columns are hidden or not; to minimise cross process calls
  21.         Erase ArrHiddenCol
  22.         ReDim ArrHiddenCol(dblGridEndColumn.Value)
  23.  
  24.         intNumberOfColumnsToExport = 0
  25.         For lngColCntr = dblGridBeginColumn.Value To dblGridEndColumn.Value
  26.             objPassedControl.Col = lngColCntr - 1
  27.             ArrHiddenCol(lngColCntr) = objPassedControl.ColHidden
  28.             If chkHiddenGridCols.CheckState Then 'export all columns
  29.                 intNumberOfColumnsToExport = intNumberOfColumnsToExport + 1
  30.             Else 'do not export hidden columns
  31.                 If Not ArrHiddenCol(lngColCntr) Then intNumberOfColumnsToExport = intNumberOfColumnsToExport + 1
  32.             End If
  33.         Next lngColCntr
  34.  
  35.         intNumberOfRowsToExport = dblGridEndRow.Value - dblGridBeginRow.Value + 1 'include the 0
  36.         'intNumberOfRowsToExport = dblGridEndRow.Value - dblGridBeginRow.Value + 1 'include the 0
  37.  
  38.         '   not to go over limitof control, amount of columns
  39.         ReDim arrExport(intArrayRows, intNumberOfColumnsToExport)
  40.  
  41.         'convert starting cell to meaningfull numbers
  42.         If Not ValidStartingCell() Then
  43.             Cursor = Cursors.Arrow
  44.             Exit Sub
  45.         End If
  46.  
  47.         If Not StartExcel() Then
  48.             Call objGeneral.DisplayMessage(Qm.Enum.EnumMainFormNET.enumMessageType.msgtApplicationMessage, Qm.Enum.EnumMainFormNET.enumMessageSource.msgsDataBase, 60341, Me.Handle.ToInt32)
  49.             'Application was not successfully started.
  50.             Cursor = Cursors.Arrow
  51.             Exit Sub
  52.         End If
  53.  
  54.         intNextExportRowNumber = lngStartingRow
  55.  
  56.         lngEndBlockRow = 0
  57.         lngStartBlockRow = 0
  58.         intRowCount = 0
  59.         intColumnCount = 0
  60.         intTotalRowCount = 0
  61.         intTotalRowsToWrite = 0
  62.         blnFirstExportFlag = False
  63.  
  64.         'make sure that the block of data returned is no too big
  65.         'a string can have approx 2 billion chars but we limit it here to a constant
  66.         'intNumberOfRowsToExport has the number of rows to export
  67.         objPassedControl.BlockMode = True
  68.         objPassedControl.Col = dblGridBeginColumn.Value - 1
  69.         objPassedControl.Col2 = dblGridEndColumn.Value - 1
  70.         lngStartBlockRow = dblGridBeginRow.Value - 1
  71.         If lngStartBlockRow + intArrayRows > dblGridEndRow.Value - 1 Then
  72.             lngEndBlockRow = dblGridEndRow.Value - 1
  73.         Else
  74.             lngEndBlockRow = lngEndBlockRow + intArrayRows
  75.         End If
  76.  
  77.         intPrevRow = -1
  78.         'intTotalRowCount has then next row to be but it started with 0 so it is the
  79.         'rows exported
  80.         Do While intTotalRowCount < intNumberOfRowsToExport 'still  more to read
  81.  
  82.             ' MsgBox(" dblGridEndRow.Value To dblGridBeginRow.Value + 1 " & dblGridEndRow.Value & " " & dblGridBeginRow.Value + 1)
  83.  
  84.             If intPrevRow = intTotalRowCount Then Exit Do
  85.  
  86.             intPrevRow = intTotalRowCount
  87.  
  88.             objPassedControl.BlockMode = True
  89.             lngPreviousStartBlockRow = lngStartBlockRow
  90.             objPassedControl.Row = lngStartBlockRow
  91.             objPassedControl.Row2 = lngEndBlockRow
  92.             lngStartBlockRow = lngEndBlockRow + 1
  93.             If lngStartBlockRow + intArrayRows > dblGridEndRow.Value - 1 Then 'adding arrayrows amount will be too much
  94.                 lngEndBlockRow = dblGridEndRow.Value - 1
  95.             Else
  96.                 lngEndBlockRow = lngStartBlockRow + intArrayRows
  97.             End If
  98.  
  99.             '        If lngEndBlockRow > 400 Then
  100.             '         Beep
  101.             '        End If
  102.  
  103.             strPassedString = objPassedControl.Clip
  104.             objPassedControl.BlockMode = False
  105.  
  106.             'find & remove all chr(10)'s in the string
  107.             'the grid puts a char(10) in front of every new line or on the end of each line
  108.             'it is captured here as on the beginning of each line
  109.             'make sure it is removed because it makes the spreadsheet row height too big
  110.  
  111.             lngTmpVar = InStr(strPassedString, Chr(10))
  112.             Do While lngTmpVar <> 0
  113.                 strPassedString = Mid(strPassedString, 1, lngTmpVar - 1) & Mid(strPassedString, lngTmpVar + 1)
  114.                 lngTmpVar = InStr(strPassedString, Chr(10))
  115.             Loop
  116.  
  117.             strPassedString = strPassedString & " " 'to cater for: strPassedString = Mid(strPassedString, InStr(strPassedString, Chr(13)) + 1)
  118.  
  119.             If Len(Trim(strPassedString)) = 0 Then
  120.                 intTotalRowCount = lngEndBlockRow
  121.             End If
  122.  
  123.             lngColCntr = dblGridBeginColumn.Value
  124.             'find first tab in string
  125.             Do Until Len(Trim(strPassedString)) = 0
  126.  
  127.                 If InStr(1, strPassedString, Chr(13)) = 0 Then 'no more lines, at the last line
  128.                     If InStr(1, strPassedString, Chr(9)) = 0 Then 'no more lines or tabs, busy with the last item
  129.                         'not(    hidden          and not export hidden rows)
  130.                         If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
  131.                             arrExport(intRowCount, intColumnCount) = FormatString(strPassedString)
  132.                             blnSomethingExported = True
  133.                             intTotalRowCount = intTotalRowCount + 1
  134.                             intTotalRowsToWrite = intTotalRowsToWrite + 1
  135.                         End If
  136.                         lngColCntr = lngColCntr + 1
  137.                         strPassedString = ""
  138.                     Else 'not busy with last item but with the last row so check for next chr(9)
  139.                         If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
  140.                             arrExport(intRowCount, intColumnCount) = FormatString(Mid(strPassedString, 1, InStr(strPassedString, Chr(9)) - 1))
  141.                             blnSomethingExported = True
  142.                             intColumnCount = intColumnCount + 1
  143.                         End If
  144.                         lngColCntr = lngColCntr + 1
  145.                         strPassedString = Mid(strPassedString, InStr(1, strPassedString, Chr(9)) + 1)
  146.                     End If
  147.                 Else 'there are more rows still because there is a chr(13)
  148.                     'see if hidden
  149.                     objPassedControl.Row = intTotalRowCount
  150.                     If objPassedControl.RowHidden And Not chkHiddenGridRows.CheckState Then
  151.                         'dont export, take out row
  152.                         strPassedString = Mid(strPassedString, InStr(strPassedString, Chr(13)) + 1)
  153.                         intTotalRowCount = intTotalRowCount + 1
  154.                         objPassedControl.Row = intTotalRowCount
  155.                         'if there are more chr(13)'s in the string, loop further
  156.                         'else you have the last row, determine if it is hidden or not
  157.                         ' if you do not you will increment the row and PassecControl.rowhidden will not be a valid check
  158.                         If InStr(1, strPassedString, Chr(13)) <> 0 Then
  159.                             'there are more rows, continue
  160.                         Else 'has one row left, determine if it is hidden or not
  161.                             If objPassedControl.RowHidden Then strPassedString = ""
  162.                         End If
  163.                     Else
  164.                         'check if there are more chr(9)'s in the passedArray
  165.                         If InStr(1, strPassedString, Chr(9)) <> 0 Then 'there are more data items separated by the chr(9)
  166.                             'see if the tab(chr(9)) or the enter(chr(13)) comes first
  167.                             If InStr(1, strPassedString, Chr(9)) < InStr(1, strPassedString, Chr(13)) Then 'there is another tab first
  168.                                 If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
  169.                                     arrExport(intRowCount, intColumnCount) = FormatString(Mid(strPassedString, 1, InStr(strPassedString, Chr(9)) - 1))
  170.                                     blnSomethingExported = True
  171.                                     intColumnCount = intColumnCount + 1
  172.                                 End If
  173.                                 lngColCntr = lngColCntr + 1
  174.                                 strPassedString = Mid(strPassedString, InStr(1, strPassedString, Chr(9)) + 1)
  175.                             Else 'the enter chr(13) is before the tab chr(9)
  176.                                 If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
  177.                                     arrExport(intRowCount, intColumnCount) = FormatString(Mid(strPassedString, 1, InStr(strPassedString, Chr(13)) - 1))
  178.                                     blnSomethingExported = True
  179.                                 End If
  180.                                 strPassedString = Mid(strPassedString, InStr(1, strPassedString, Chr(13)) + 1)
  181.                                 intRowCount = intRowCount + 1
  182.                                 intTotalRowCount = intTotalRowCount + 1
  183.                                 intTotalRowsToWrite = intTotalRowsToWrite + 1
  184.                                 intColumnCount = 0
  185.                                 lngColCntr = dblGridBeginColumn.Value
  186.                                 objPassedControl.Row = intTotalRowCount
  187.  
  188.  
  189.                                 'if next row is hidden and must not be exported, remove it
  190.                                 Do While objPassedControl.RowHidden And Not chkHiddenGridRows.CheckState
  191.                                     strPassedString = Mid(strPassedString, InStr(strPassedString, Chr(13)) + 1)
  192.                                     intTotalRowCount = intTotalRowCount + 1
  193.                                     objPassedControl.Row = intTotalRowCount
  194.                                     'if there are more chr(13)'s in the string, loop further
  195.                                     'else you have the last row, determine if it is hidden or not
  196.                                     ' if you do not you will increment the row and PassecControl.rowhidden will not be a valid check
  197.                                     If InStr(1, strPassedString, Chr(13)) <> 0 Then
  198.                                         'there are more rows, continue
  199.                                     Else
  200.                                         'has one row left, determine if it is hidden or not
  201.                                         If objPassedControl.RowHidden Then strPassedString = ""
  202.                                         Exit Do
  203.                                     End If
  204.                                 Loop
  205.                             End If
  206.                         Else 'there are just more chr(13)'s in the row
  207.                             If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
  208.                                 arrExport(intRowCount, intColumnCount) = FormatString(Mid(strPassedString, 1, InStr(strPassedString, Chr(13)) - 1))
  209.                                 blnSomethingExported = True
  210.                             End If
  211.                             strPassedString = Mid(strPassedString, InStr(1, strPassedString, Chr(13)) + 1)
  212.                             intRowCount = intRowCount + 1
  213.                             intTotalRowCount = intTotalRowCount + 1
  214.                             intTotalRowsToWrite = intTotalRowsToWrite + 1
  215.                             intColumnCount = 0
  216.                             lngColCntr = dblGridBeginColumn.Value
  217.                             objPassedControl.Row = intTotalRowCount
  218.                             'if next row is hidden and must not be exported, remove it
  219.                             If Len(Trim(strPassedString)) > 0 Then
  220.                                 Do While objPassedControl.RowHidden And Not chkHiddenGridRows.CheckState
  221.                                     strPassedString = Mid(strPassedString, InStr(strPassedString, Chr(13)) + 1)
  222.                                     intTotalRowCount = intTotalRowCount + 1
  223.                                     objPassedControl.Row = intTotalRowCount
  224.                                     'if there are more chr(13)'s in the string, loop further
  225.                                     'else you have the last row, determine if it is hidden or not
  226.                                     ' if you do not you will increment the row and objPassedControl.rowhidden will not be a valid check
  227.                                     If InStr(1, strPassedString, Chr(13)) <> 0 Then
  228.                                         'there are more rows, continue
  229.                                     Else
  230.                                         'has one row left, determine if it is hidden or not
  231.                                         If objPassedControl.RowHidden Then
  232.                                             strPassedString = ""
  233.                                         End If
  234.                                         Exit Do
  235.                                     End If
  236.                                 Loop
  237.                             End If
  238.                         End If
  239.                     End If 'if row hidden
  240.                 End If 'if there are more rows
  241.             Loop
  242.  
  243.             If blnSomethingExported = True Then Call ExportGridDataToExcelSub()
  244.             If (intNumberOfRowsToExport > 0) And intTotalRowCount / intNumberOfRowsToExport * 100 <= 100 Then prgExport.Value = intTotalRowCount / intNumberOfRowsToExport * 100
  245.             'prgExport.Value = intTotalRowCount / intNumberOfRowsToExport * 100
  246.  
  247.         Loop
  248.  
  249.         prgExport.Value = 0
  250.         objXl.Cells.Select()
  251.         objXl.Selection.Columns.AutoFit()
  252.         objXl.Range("A" & lngStartingRow + 1).Select()
  253.         objXl.ActiveWindow.FreezePanes = True
  254.  
  255.         '            objXl.ActiveSheet.Range("A" & intTotalRowsToWrite + lngStartingRow + 1 & ":" & "A" & (intTotalRowsToWrite + lngStartingRow + 1) & "").Value = "Export Run By"
  256.         '            objXl.ActiveSheet.Range("B" & intTotalRowsToWrite + lngStartingRow + 1 & ":" & "B" & (intTotalRowsToWrite + lngStartingRow + 1) & "").Value = objGeneral.UserName & " --> " & objGeneral.UserID
  257.         '            objXl.ActiveSheet.Range("A" & intTotalRowsToWrite + lngStartingRow + 2 & ":" & "A" & (intTotalRowsToWrite + lngStartingRow + 2) & "").Value = "Export Run On"
  258.         '            objXl.ActiveSheet.Range("B" & intTotalRowsToWrite + lngStartingRow + 2 & ":" & "B" & (intTotalRowsToWrite + lngStartingRow + 2) & "").Value = objGeneral.TodaysDate
  259.  
  260.         objXl.Visible = True
  261.         Call objGeneral.DisplayMessage(Qm.Enum.EnumMainFormNET.enumMessageType.msgtApplicationMessage, Qm.Enum.EnumMainFormNET.enumMessageSource.msgsDataBase, 60339, Me.Handle.ToInt32, intTotalRowsToWrite.ToString)
  262.         '~~ records successfully exported.
  263.         objXl = Nothing
  264.  
  265. ErrorHandler:
  266.         If Err.Number <> 0 Then objGeneral.DisplayMessage(Qm.Enum.EnumMainFormNET.enumMessageType.msgtMessageBox, Qm.Enum.EnumMainFormNET.enumMessageSource.msgsResourceFile, 999, 0, MsgBoxStyle.Critical, "Qmuzik", Err.Number, Err.Description)
  267.     End Sub



Kind regards,
Jun 26 '14 #1
Share this question for a faster answer!
Share on Google+

Post your reply

Sign in to post your reply or Sign up for a free account.