Do while loop slow - optimization???

[lungy]

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

Sub ExportGridToExcel()
 
        On Error GoTo ErrorHandler
 
        Dim lngColCntr As Integer
        Dim strPassedString As String
        Dim lngTmpVar As Integer
        Dim intPrevRow As Integer
        Erase arrExport
        blnSomethingExported = False
 
        'check that to column >= to column
        If (dblGridEndRow.Value < dblGridBeginRow.Value) Or (dblGridEndColumn.Value < dblGridBeginColumn.Value) Then
            Call objGeneral.DisplayMessage(Qm.Enum.EnumMainFormNET.enumMessageType.msgtApplicationMessage, Qm.Enum.EnumMainFormNET.enumMessageSource.msgsDataBase, 60340, Me.Handle.ToInt32)
            'End Row/Column may not be greater than Begin Row/Column.
            Cursor = Cursors.Arrow
            Exit Sub
        End If
 
        'array to indicate if columns are hidden or not; to minimise cross process calls
        Erase ArrHiddenCol
        ReDim ArrHiddenCol(dblGridEndColumn.Value)
 
        intNumberOfColumnsToExport = 0
        For lngColCntr = dblGridBeginColumn.Value To dblGridEndColumn.Value
            objPassedControl.Col = lngColCntr - 1
            ArrHiddenCol(lngColCntr) = objPassedControl.ColHidden
            If chkHiddenGridCols.CheckState Then 'export all columns
                intNumberOfColumnsToExport = intNumberOfColumnsToExport + 1
            Else 'do not export hidden columns
                If Not ArrHiddenCol(lngColCntr) Then intNumberOfColumnsToExport = intNumberOfColumnsToExport + 1
            End If
        Next lngColCntr
 
        intNumberOfRowsToExport = dblGridEndRow.Value - dblGridBeginRow.Value + 1 'include the 0
        'intNumberOfRowsToExport = dblGridEndRow.Value - dblGridBeginRow.Value + 1 'include the 0
 
        '   not to go over limitof control, amount of columns
        ReDim arrExport(intArrayRows, intNumberOfColumnsToExport)
 
        'convert starting cell to meaningfull numbers
        If Not ValidStartingCell() Then
            Cursor = Cursors.Arrow
            Exit Sub
        End If
 
        If Not StartExcel() Then
            Call objGeneral.DisplayMessage(Qm.Enum.EnumMainFormNET.enumMessageType.msgtApplicationMessage, Qm.Enum.EnumMainFormNET.enumMessageSource.msgsDataBase, 60341, Me.Handle.ToInt32)
            'Application was not successfully started.
            Cursor = Cursors.Arrow
            Exit Sub
        End If
 
        intNextExportRowNumber = lngStartingRow
 
        lngEndBlockRow = 0
        lngStartBlockRow = 0
        intRowCount = 0
        intColumnCount = 0
        intTotalRowCount = 0
        intTotalRowsToWrite = 0
        blnFirstExportFlag = False
 
        'make sure that the block of data returned is no too big
        'a string can have approx 2 billion chars but we limit it here to a constant
        'intNumberOfRowsToExport has the number of rows to export
        objPassedControl.BlockMode = True
        objPassedControl.Col = dblGridBeginColumn.Value - 1
        objPassedControl.Col2 = dblGridEndColumn.Value - 1
        lngStartBlockRow = dblGridBeginRow.Value - 1
        If lngStartBlockRow + intArrayRows > dblGridEndRow.Value - 1 Then
            lngEndBlockRow = dblGridEndRow.Value - 1
        Else
            lngEndBlockRow = lngEndBlockRow + intArrayRows
        End If
 
        intPrevRow = -1
        'intTotalRowCount has then next row to be but it started with 0 so it is the
        'rows exported
        Do While intTotalRowCount < intNumberOfRowsToExport 'still  more to read
 
            ' MsgBox(" dblGridEndRow.Value To dblGridBeginRow.Value + 1 " & dblGridEndRow.Value & " " & dblGridBeginRow.Value + 1)
 
            If intPrevRow = intTotalRowCount Then Exit Do
 
            intPrevRow = intTotalRowCount
 
            objPassedControl.BlockMode = True
            lngPreviousStartBlockRow = lngStartBlockRow
            objPassedControl.Row = lngStartBlockRow
            objPassedControl.Row2 = lngEndBlockRow
            lngStartBlockRow = lngEndBlockRow + 1
            If lngStartBlockRow + intArrayRows > dblGridEndRow.Value - 1 Then 'adding arrayrows amount will be too much
                lngEndBlockRow = dblGridEndRow.Value - 1
            Else
                lngEndBlockRow = lngStartBlockRow + intArrayRows
            End If
 
            '        If lngEndBlockRow > 400 Then
            '         Beep
            '        End If
 
            strPassedString = objPassedControl.Clip
            objPassedControl.BlockMode = False
 
            'find & remove all chr(10)'s in the string
            'the grid puts a char(10) in front of every new line or on the end of each line
            'it is captured here as on the beginning of each line
            'make sure it is removed because it makes the spreadsheet row height too big
 
            lngTmpVar = InStr(strPassedString, Chr(10))
            Do While lngTmpVar <> 0
                strPassedString = Mid(strPassedString, 1, lngTmpVar - 1) & Mid(strPassedString, lngTmpVar + 1)
                lngTmpVar = InStr(strPassedString, Chr(10))
            Loop
 
            strPassedString = strPassedString & " " 'to cater for: strPassedString = Mid(strPassedString, InStr(strPassedString, Chr(13)) + 1)
 
            If Len(Trim(strPassedString)) = 0 Then
                intTotalRowCount = lngEndBlockRow
            End If
 
            lngColCntr = dblGridBeginColumn.Value
            'find first tab in string
            Do Until Len(Trim(strPassedString)) = 0
 
                If InStr(1, strPassedString, Chr(13)) = 0 Then 'no more lines, at the last line
                    If InStr(1, strPassedString, Chr(9)) = 0 Then 'no more lines or tabs, busy with the last item
                        'not(    hidden          and not export hidden rows)
                        If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
                            arrExport(intRowCount, intColumnCount) = FormatString(strPassedString)
                            blnSomethingExported = True
                            intTotalRowCount = intTotalRowCount + 1
                            intTotalRowsToWrite = intTotalRowsToWrite + 1
                        End If
                        lngColCntr = lngColCntr + 1
                        strPassedString = ""
                    Else 'not busy with last item but with the last row so check for next chr(9)
                        If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
                            arrExport(intRowCount, intColumnCount) = FormatString(Mid(strPassedString, 1, InStr(strPassedString, Chr(9)) - 1))
                            blnSomethingExported = True
                            intColumnCount = intColumnCount + 1
                        End If
                        lngColCntr = lngColCntr + 1
                        strPassedString = Mid(strPassedString, InStr(1, strPassedString, Chr(9)) + 1)
                    End If
                Else 'there are more rows still because there is a chr(13)
                    'see if hidden
                    objPassedControl.Row = intTotalRowCount
                    If objPassedControl.RowHidden And Not chkHiddenGridRows.CheckState Then
                        'dont export, take out row
                        strPassedString = Mid(strPassedString, InStr(strPassedString, Chr(13)) + 1)
                        intTotalRowCount = intTotalRowCount + 1
                        objPassedControl.Row = intTotalRowCount
                        'if there are more chr(13)'s in the string, loop further
                        'else you have the last row, determine if it is hidden or not
                        ' if you do not you will increment the row and PassecControl.rowhidden will not be a valid check
                        If InStr(1, strPassedString, Chr(13)) <> 0 Then
                            'there are more rows, continue
                        Else 'has one row left, determine if it is hidden or not
                            If objPassedControl.RowHidden Then strPassedString = ""
                        End If
                    Else
                        'check if there are more chr(9)'s in the passedArray
                        If InStr(1, strPassedString, Chr(9)) <> 0 Then 'there are more data items separated by the chr(9)
                            'see if the tab(chr(9)) or the enter(chr(13)) comes first
                            If InStr(1, strPassedString, Chr(9)) < InStr(1, strPassedString, Chr(13)) Then 'there is another tab first
                                If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
                                    arrExport(intRowCount, intColumnCount) = FormatString(Mid(strPassedString, 1, InStr(strPassedString, Chr(9)) - 1))
                                    blnSomethingExported = True
                                    intColumnCount = intColumnCount + 1
                                End If
                                lngColCntr = lngColCntr + 1
                                strPassedString = Mid(strPassedString, InStr(1, strPassedString, Chr(9)) + 1)
                            Else 'the enter chr(13) is before the tab chr(9)
                                If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
                                    arrExport(intRowCount, intColumnCount) = FormatString(Mid(strPassedString, 1, InStr(strPassedString, Chr(13)) - 1))
                                    blnSomethingExported = True
                                End If
                                strPassedString = Mid(strPassedString, InStr(1, strPassedString, Chr(13)) + 1)
                                intRowCount = intRowCount + 1
                                intTotalRowCount = intTotalRowCount + 1
                                intTotalRowsToWrite = intTotalRowsToWrite + 1
                                intColumnCount = 0
                                lngColCntr = dblGridBeginColumn.Value
                                objPassedControl.Row = intTotalRowCount
 
 
                                'if next row is hidden and must not be exported, remove it
                                Do While objPassedControl.RowHidden And Not chkHiddenGridRows.CheckState
                                    strPassedString = Mid(strPassedString, InStr(strPassedString, Chr(13)) + 1)
                                    intTotalRowCount = intTotalRowCount + 1
                                    objPassedControl.Row = intTotalRowCount
                                    'if there are more chr(13)'s in the string, loop further
                                    'else you have the last row, determine if it is hidden or not
                                    ' if you do not you will increment the row and PassecControl.rowhidden will not be a valid check
                                    If InStr(1, strPassedString, Chr(13)) <> 0 Then
                                        'there are more rows, continue
                                    Else
                                        'has one row left, determine if it is hidden or not
                                        If objPassedControl.RowHidden Then strPassedString = ""
                                        Exit Do
                                    End If
                                Loop
                            End If
                        Else 'there are just more chr(13)'s in the row
                            If Not (ArrHiddenCol(lngColCntr) And Not chkHiddenGridCols.CheckState) Then
                                arrExport(intRowCount, intColumnCount) = FormatString(Mid(strPassedString, 1, InStr(strPassedString, Chr(13)) - 1))
                                blnSomethingExported = True
                            End If
                            strPassedString = Mid(strPassedString, InStr(1, strPassedString, Chr(13)) + 1)
                            intRowCount = intRowCount + 1
                            intTotalRowCount = intTotalRowCount + 1
                            intTotalRowsToWrite = intTotalRowsToWrite + 1
                            intColumnCount = 0
                            lngColCntr = dblGridBeginColumn.Value
                            objPassedControl.Row = intTotalRowCount
                            'if next row is hidden and must not be exported, remove it
                            If Len(Trim(strPassedString)) > 0 Then
                                Do While objPassedControl.RowHidden And Not chkHiddenGridRows.CheckState
                                    strPassedString = Mid(strPassedString, InStr(strPassedString, Chr(13)) + 1)
                                    intTotalRowCount = intTotalRowCount + 1
                                    objPassedControl.Row = intTotalRowCount
                                    'if there are more chr(13)'s in the string, loop further
                                    'else you have the last row, determine if it is hidden or not
                                    ' if you do not you will increment the row and objPassedControl.rowhidden will not be a valid check
                                    If InStr(1, strPassedString, Chr(13)) <> 0 Then
                                        'there are more rows, continue
                                    Else
                                        'has one row left, determine if it is hidden or not
                                        If objPassedControl.RowHidden Then
                                            strPassedString = ""
                                        End If
                                        Exit Do
                                    End If
                                Loop
                            End If
                        End If
                    End If 'if row hidden
                End If 'if there are more rows
            Loop
 
            If blnSomethingExported = True Then Call ExportGridDataToExcelSub()
            If (intNumberOfRowsToExport > 0) And intTotalRowCount / intNumberOfRowsToExport * 100 <= 100 Then prgExport.Value = intTotalRowCount / intNumberOfRowsToExport * 100
            'prgExport.Value = intTotalRowCount / intNumberOfRowsToExport * 100
 
        Loop
 
        prgExport.Value = 0
        objXl.Cells.Select()
        objXl.Selection.Columns.AutoFit()
        objXl.Range("A" & lngStartingRow + 1).Select()
        objXl.ActiveWindow.FreezePanes = True
 
        '            objXl.ActiveSheet.Range("A" & intTotalRowsToWrite + lngStartingRow + 1 & ":" & "A" & (intTotalRowsToWrite + lngStartingRow + 1) & "").Value = "Export Run By"
        '            objXl.ActiveSheet.Range("B" & intTotalRowsToWrite + lngStartingRow + 1 & ":" & "B" & (intTotalRowsToWrite + lngStartingRow + 1) & "").Value = objGeneral.UserName & " --> " & objGeneral.UserID
        '            objXl.ActiveSheet.Range("A" & intTotalRowsToWrite + lngStartingRow + 2 & ":" & "A" & (intTotalRowsToWrite + lngStartingRow + 2) & "").Value = "Export Run On"
        '            objXl.ActiveSheet.Range("B" & intTotalRowsToWrite + lngStartingRow + 2 & ":" & "B" & (intTotalRowsToWrite + lngStartingRow + 2) & "").Value = objGeneral.TodaysDate
 
        objXl.Visible = True
        Call objGeneral.DisplayMessage(Qm.Enum.EnumMainFormNET.enumMessageType.msgtApplicationMessage, Qm.Enum.EnumMainFormNET.enumMessageSource.msgsDataBase, 60339, Me.Handle.ToInt32, intTotalRowsToWrite.ToString)
        '~~ records successfully exported.
        objXl = Nothing
 
ErrorHandler:
        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)
    End Sub

Kind regards,