Solved

Performance enhancement

Posted on 2016-10-19
39
37 Views
Last Modified: 2016-10-20
Hello,
I have this procedure which exports dg rows to excel.
Is there any way I can speed it up .
 Function ExportToExcel(ByVal intCreateNew As Integer, ByVal dtGridData As DataTable, ByVal FilePath As String, ByVal StrSheetname As String, Optional ByVal xlApp As Excel.Application = Nothing) As String
        Dim xlWorkBook As Excel.Workbook = Nothing
        Dim xlWorkSheet As Excel.Worksheet = Nothing
        Dim FlgExcelOpen As Boolean = False
        Application.DoEvents()
        Try
            FrmMain.Cursor = Cursors.WaitCursor

            Try

                If intCreateNew = 0 Then
                    FlgExcelOpen = ChkExcelFileIsOpen(FilePath, xlApp)
                    If FlgExcelOpen = True Then
                        FormatMessage(21, FilePath & "   :  ",, "Excel Export")
                        '  MessageBox.Show("The excel file" & FilePath & "is already opened,please close the file and try again")
                        Return "Close"

                    End If
                    xlApp.DisplayAlerts = False
                    xlApp.Workbooks.Add()

                End If

                If IsNothing(FilePath) = True Then
                    xlWorkSheet = Nothing
                    xlWorkBook = Nothing
                    xlApp = Nothing
                    FrmMain.Cursor = Cursors.Default
                    Return "Cancelled"
                    Exit Function
                End If
                xlApp.Workbooks(1).SaveAs(FilePath)
                Application.DoEvents()
            Catch ex As Exception

                xlApp = New Excel.Application '*** Create excel app only once.
                xlApp.Workbooks.Add()
            End Try

            xlWorkBook = xlApp.Workbooks.Open(FilePath)
            ' xlWorkBook = xlApp.Workbooks.Open(FilePath, FileMode.Append, FileAccess.ReadWrite, FileShare.ReadWrite)

            If intCreateNew = 0 Then
                xlWorkSheet = xlWorkBook.Worksheets(xlWorkBook.Worksheets.Count)
            Else
                xlWorkBook.Worksheets.Add(After:=xlWorkBook.Worksheets(xlWorkBook.Worksheets.Count))
                xlWorkSheet = xlWorkBook.Worksheets(xlWorkBook.Worksheets.Count)
            End If
            xlWorkSheet.Name = StrSheetname
            With xlWorkSheet.PageSetup
                .PrintGridlines = True
                .CenterHeader = StrSheetname
                .Zoom = False
                .Orientation = Excel.XlPageOrientation.xlLandscape
                .Order = Excel.XlOrder.xlOverThenDown
            End With
            Dim dtRowCount As Integer = dtGridData.Rows.Count
            Dim dtColCount As Integer = dtGridData.Columns.Count

            Dim objXlColHeaderData(1, dtGridData.Columns.Count) As Object
            Application.DoEvents()
            For i As Integer = 0 To dtColCount - 1
                objXlColHeaderData(0, i) = dtGridData.Columns(i).ColumnName
            Next
            Dim objXlData(dtRowCount, dtColCount) As Object
            For iRow As Integer = 0 To dtRowCount - 1

                For iCol As Integer = 0 To dtColCount - 1
                    Application.DoEvents()
                    If Not IsDBNull(dtGridData.Rows(iRow).Item(iCol)) Then

                        Select Case StrSheetname.ToUpper
                            Case "DIRRY"

                                objXlData(iRow, iCol) = "'" & dtGridData.Rows(iRow).Item(iCol)

                            Case "INECTORY"

                                objXlData(iRow, iCol) = "'" & dtGridData.Rows(iRow).Item(iCol)

                            'Case "RY"

                            '    objXlData(iRow, iCol) = "'" & dtGridData.Rows(iRow).Item(iCol)

                            Case "COCE"

                                objXlData(iRow, iCol) = "'" & dtGridData.Rows(iRow).Item(iCol)

                                'Case "SPEQUEST"
                                '    objXlData(iRow, iCol) = "'" & dtGridData.Rows(iRow).Item(iCol)

                            Case Else
                                objXlData(iRow, iCol) = dtGridData.Rows(iRow).Item(iCol)
                                'objXlData(iRow, iCol) = "'" & dtGridData.Rows(iRow).Item(iCol)

                        End Select

                    Else
                        objXlData(iRow, iCol) = ""
                    End If
                Next
            Next
            Dim xlRange As Excel.Range = xlWorkSheet.Range("A1")
            xlRange = xlRange.Resize(dtRowCount, dtColCount)

            xlRange.Value2 = objXlColHeaderData
            xlWorkSheet.Range(xlWorkSheet.Cells(1, 1), xlWorkSheet.Cells(1, dtColCount)).Font.Bold = True
            Select Case StrSheetname.ToUpper
                'Formatting the dates on excel please check the column names  refer stored procedure for columns
                '[MEDICAL_Select_Correspondence]

                Case "DY"
                    xlRange = xlWorkSheet.Range("C1")
                    xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    xlRange = xlWorkSheet.Range("D1")
                    xlRange.EntireColumn.NumberFormat = "hh:mm"
                    xlRange = xlWorkSheet.Range("E1")
                    xlRange.EntireColumn.NumberFormat = "hh:mm"
                    'For Each strX As String In New String() {"D", "E"}
                    '    xlRange = xlWorkSheet.Range(strX + "1")
                    '    xlRange.EntireColumn.NumberFormat = "hh:mm"

                    'Next
                    ' xlRange = xlWorkSheet.Range("U1")
                    ' xlRange.EntireColumn.NumberFormat = "#,##0.00"
                   ' xlWorkSheet.Range("U:U").NumberFormat = "#,##0.00"
                Case "CORRESPONDENCE"
                    xlRange = xlWorkSheet.Range("A1")
                    xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"

                Case "SLET"
                    'xlRange = xlWorkSheet.Range("C1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    'xlRange = xlWorkSheet.Range("D1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    'xlRange = xlWorkSheet.Range("K1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    'xlRange = xlWorkSheet.Range("O1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    'xlRange = xlWorkSheet.Range("V1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    'xlRange = xlWorkSheet.Range("W1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    'xlRange = xlWorkSheet.Range("Y1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"

                    For Each strX As String In New String() {"C", "D", "K", "O", "V", "W", "Y1"}
                        xlRange = xlWorkSheet.Range(strX + "1")
                        xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    Next
                    For Each strX As String In New String() {"I", "J", "M", "Q", "R", "T", "U", "X"}
                        xlRange = xlWorkSheet.Range(strX + "1")
                        xlRange.EntireColumn.NumberFormat = "#,##0.00"
                    Next

                Case "CLIENT_REFERENCE"
                    xlRange = xlWorkSheet.Range("E1")
                    xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"

                Case "SPECIAL_PAYMENT_REQUEST"
                    'xlRange = xlWorkSheet.Range("H1")
                    xlWorkSheet.Range("H:H").NumberFormat = "#,##0.00"
                    ' xlRange.EntireColumn.NumberFormat = "#,##0.00"
                    xlRange = xlWorkSheet.Range("C1")
                    xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"

                Case "CR"
                    xlRange = xlWorkSheet.Range("B1")
                    xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"

                Case "CLIC"
                    'xlRange = xlWorkSheet.Range("C1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    'xlRange = xlWorkSheet.Range("G1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    'xlRange = xlWorkSheet.Range("J1")
                    'xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"

                    xlWorkSheet.Range("k:k").NumberFormat = "#,##0.00"
                    For Each strX As String In New String() {"C", "G", "J"}
                        xlRange = xlWorkSheet.Range(strX + "1")
                        xlRange.EntireColumn.NumberFormat = "dd/mm/yyyy"
                    Next

            End Select

            xlRange = xlWorkSheet.Range("A2")

            xlRange = xlRange.Resize(dtRowCount, dtColCount)
            ' xlRange = xlRange.Resize(dtRowCount + 1, dtColCount + 1)
            xlRange.Value2 = objXlData

            'With xlWorkSheet
            '    .Range(.Cells(1, 1), .Cells(1, 1)).Select()
            'End With
            'With xlWorkSheet.Application.ActiveWindow
            '    .SplitColumn = 0
            '    .SplitRow = 1
            'End With
            'With xlWorkSheet
            '    .Cells.EntireColumn.AutoFit()
            '    .Cells.EntireRow.AutoFit()
            '    '.Application.ActiveWindow.FreezePanes = True
            'End With

            'CType(xlApp.ActiveWorkbook.Sheets(1), Excel.Worksheet).Select()

            xlWorkBook.Save()

        Catch ex As Exception
            MessageBox.Show(ex.Message, "ErrorIn ExportToExcel", MessageBoxButtons.OK, MessageBoxIcon.Error)
            xlWorkSheet = Nothing
            xlWorkBook = Nothing
            xlApp = Nothing
            FrmMain.Cursor = Cursors.Default
            Return "False"
        Finally
            FrmMain.Cursor = Cursors.Default
        End Try
        Return "True"
    End Function

Open in new window

0
Comment
Question by:RIAS
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 24
  • 14
39 Comments
 
LVL 27

Expert Comment

by:skullnobrains
ID: 41849864
i'm not good at vb but it seems to me that you open the file multiple times

you also loop over the file multiple times. can't you format the dates before writing them or better directly in the stored procedure rather than reparsing the whole file ?

it is usually much simpler and efficient to export to csv if feasible. since your pagesetup seems to be the default settings, and dd/mm/yyyy will be handled as a date in excel natively ( not sure about dd/mm/yy ) there might be little gain produced by using the actual excel file format.
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41850007
have you been able to identify which section of your method takes the most time?
0
 

Author Comment

by:RIAS
ID: 41850046
Nope. How can I find it?
I am using vb.net 2015

Cheers
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41850080
You can use the StopWatch object and output the Ellapsedtime property here and there in your methods. Check https://www.dotnetperls.com/stopwatch-vbnet
0
 

Author Comment

by:RIAS
ID: 41850094
Ok will try and get back
0
 

Author Comment

by:RIAS
ID: 41850267
Eric,

There is subroutine which is causing delay .
Anything i can do about it
 Public Function CreateDataTableFromSelectedRows(ByVal Dg As DataGridView, ByVal intTabnumber As Integer) As DataTable

        Dim FlgRemoveLastColumn As Boolean = False 'Hide U_ID in excel sheet
        If IsNothing(Dg.DataSource) = False Then
            If TypeOf CType(Dg, DataGridView).DataSource Is DataView Then
            Else
                Select Case intTabnumber
                    Case 0
                        'StrTabname = "DARY"
                        FlgRemoveLastColumn = True
                    Case 1
                        'StrTabname = "CORONDENCE"
                        FlgRemoveLastColumn = True
                    Case 2
                        ' StrTabname = "DIRECRY"
                        FlgRemoveLastColumn = True
                    Case 3
                        'StrTabname = "INTEECTORY"
                        FlgRemoveLastColumn = False
                    Case 4
                        ' StrTabname = "SH_LET"
                        FlgRemoveLastColumn = True
                    Case 5
                        ' StrTabname = "CLIEENCE"
                        FlgRemoveLastColumn = False
                    Case 6
                        'StrTabname = "SPEQUEST"
                        FlgRemoveLastColumn = False
                    Case 7
                        ' StrTabname = "CR"
                        FlgRemoveLastColumn = False

                    Case 8
                        'StrTabname = "NORM"
                        FlgRemoveLastColumn = False
                    Case 9
                        ' StrTabname = "CIC"
                        FlgRemoveLastColumn = True
                End Select

                Dim dt As DataTable = DirectCast(Dg.DataSource, DataTable).Clone()
                For Each row As DataGridViewRow In Dg.Rows
                    If IsDBNull(Dg.Rows(row.Index).Cells(0).Value) = False AndAlso (Dg.Rows(row.Index).Cells(0).Value) = True Then

                        Dim dr = DirectCast(Dg.Rows(row.Index).DataBoundItem, System.Data.DataRowView).Row
                        dt.ImportRow(dr)
                    End If
                Next

                If FlgRemoveLastColumn = True Then
                    dt.Columns.RemoveAt(dt.Columns.Count - 1) 'Remove the select column from excel export
                End If
                dt.AcceptChanges()
                If dt.Rows.Count = 0 Then
                    Return Nothing
                Else
                    dt.Columns.Remove("Sel") 'Remove the select column from excel export
                    Return dt
                End If
                Exit Function
            End If
        End If
        Return Nothing
    End Function

Open in new window

0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41850279
when you say delays, how long does it take?

How many rows do you have in your datagrid?
0
 

Author Comment

by:RIAS
ID: 41850286
I have around 3000 rows.
Compare to the rest of the sections .This is the one which takes longer.
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41850365
but how long? is is 1 second or 1 hour?
0
 

Author Comment

by:RIAS
ID: 41850395
2 minutes
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41850447
1 thing I would really try would be to replace lines 41 to 48. I would loop directly through the collection of rows of the datatable instead of having to cast each row!

Try something like this (not tested):

                Dim dt As DataTable = DirectCast(Dg.DataSource, DataTable).Clone()
                For Each row As DataRow In dt.Rows
                    If IsDBNull(row.Item(0).Value) = False AndAlso (row.Item(0).Value) = True Then
                        dt.ImportRow(row)
                    End If
                Next

Open in new window


And if your column 0 is that a checkbox to select some rows? If this is the case, it would be even shorter to do this:
    Dim drs() As DataRow = dt.Select("Sel <> 0")
           For Each dr As DataRow In drs

Open in new window

0
 

Author Comment

by:RIAS
ID: 41850451
Yes the fitst column is for selection
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41850463
use something like this:
Dim dt As DataTable = DirectCast(Dg.DataSource, DataTable).Clone()
Dim drs() As DataRow = DirectCast(Dg.DataSource, DataTable).Select("Sel <> 0")
For Each dr As DataRow In drs
   dt.ImportRow(row)
Next

Open in new window

0
 

Author Comment

by:RIAS
ID: 41850465
Eric,
Will it work even when the datagridview is sorted?
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41850485
that I don't know, you will have to try but it should work since your are casting the datasource as a table.
0
 

Author Comment

by:RIAS
ID: 41850486
Ok Eric will try and get back by tomorrow as I am away from the screen. Thanks
0
 

Author Comment

by:RIAS
ID: 41851659
Hello Eric,
Dim drs() As DataRow = DirectCast(Dg.DataSource, DataTable).Select("Sel <> 0")
Even though the rows are selected it shows

drs is empty
 
is not getting any selected rows .
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41851748
how is your Sel column defined?
0
 

Author Comment

by:RIAS
ID: 41851750
.Columns.Add("Sel", GetType(Object))
                .Columns("Sel").SetOrdinal(0)
0
 

Author Comment

by:RIAS
ID: 41851753
But when I view the datatable the value in it is True/False
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41851755
>>.Columns.Add("Sel", GetType(Object))

try to create it with a Integer datatype (instead) of object

>>But when I view the datatable the value in it is True/False

Surely because you have set a display datatype for the column in the grid.
0
 

Author Comment

by:RIAS
ID: 41851756
Ok,will try
0
 

Author Comment

by:RIAS
ID: 41851760
Eric,
This change will make me change a lot of code.
Can we have a work around for object
0
 
LVL 70

Accepted Solution

by:
Éric Moreau earned 500 total points
ID: 41851889
I am not sure that changing the datatype would require that much changes.

you can also try:
Dim drs() As DataRow = DirectCast(Dg.DataSource, DataTable).Select("Sel is not null and Sel <> 0")

Open in new window

0
 

Author Comment

by:RIAS
ID: 41851933
Ok,will try and get back.

Cheers!
0
 

Author Comment

by:RIAS
ID: 41851968
Nope no luck still.
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41851978
I don't have time to create an dummy application to test it right now. Have you tried changing your datatype to int? Do you have self-contained sample code I can try without having to create a full demo myself?
0
 

Author Comment

by:RIAS
ID: 41851979
Thius worked Eric but, it just selects one row,are we missing a loop ?

   Dim expression As String
                expression = "Sel <> False"

                Dim dt As DataTable = DirectCast(Dg.DataSource, DataTable).Clone()
                Dim drs() As DataRow = DirectCast(Dg.DataSource, DataTable).Select(expression)
                For Each dr As DataRow In drs
                    dt.ImportRow(dr)
                Next

Open in new window

0
 

Author Comment

by:RIAS
ID: 41851989
It leaves one row less selected.I don't know why it is happening
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41851997
I don't understand what you mean.  Do you have self-contained sample code I can try without having to create a full demo myself?
0
 

Author Comment

by:RIAS
ID: 41852127
Eric,
I changed the it to integer but, still the same .

  Dim expression As String
                expression = "Sel=1"
                Dim dt As DataTable = DirectCast(Dg.DataSource, DataTable).Clone()
                Dim drs() As DataRow = DirectCast(Dg.DataSource, DataTable).Select(expression)
                For Each dr As DataRow In drs
                    dt.ImportRow(dr)
                Next

Open in new window

0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41852138
I need your sample. There is something else. Or maybe because it is coming from the datagrid, it is already a boolean.

have you tried:
expression = "Sel=True"

Open in new window

0
 

Author Comment

by:RIAS
ID: 41852142
Now since I have converted it to intger the values shows 0,1 in the sel column .
0
 

Author Comment

by:RIAS
ID: 41852143
Do you want my datatable data ?
0
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 41852148
I mean a self-contained app with the grid and fake data so that I don't have to create it by myself.
0
 

Author Comment

by:RIAS
ID: 41852151
Just found something like:

   Dim drs() As DataRow = DirectCast(Dg.DataSource, DataTable).Select(expression, "", DataViewRowState.ModifiedCurrent)

Open in new window


Additional parameters
0
 

Author Comment

by:RIAS
ID: 41852238
                Dim expression As String
                expression = "Sel <> 0"
           [b]     Dg.DataSource.acceptchanges[/b]
                Dim dt As DataTable = DirectCast(Dg.DataSource, DataTable).Clone()
                Dim drs() As DataRow = DirectCast(Dg.DataSource, DataTable).Select(expression)
                For Each dr As DataRow In drs
                    dt.ImportRow(dr)
                Next

Open in new window

0
 

Author Comment

by:RIAS
ID: 41852239
Eric it worked with above code!

      Dg.DataSource.acceptchanges this was the key
0
 

Author Closing Comment

by:RIAS
ID: 41852240
Thanks  for all your help as always!
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Well, all of us have seen the multiple EXCEL.EXE's in task manager that won't die even if you call the .close, .dispose methods. Try this method to kill any excels in memory. You can copy the kill function to create a check function and replace the …
Introduction As chip makers focus on adding processor cores over increasing clock speed, developers need to utilize the features of modern CPUs.  One of the ways we can do this is by implementing parallel algorithms in our software.   One recent…
In this video, viewers will be given step by step instructions on adjusting mouse, pointer and cursor visibility in Microsoft Windows 10. The video seeks to educate those who are struggling with the new Windows 10 Graphical User Interface. Change Cu…
NetCrunch network monitor is a highly extensive platform for network monitoring and alert generation. In this video you'll see a live demo of NetCrunch with most notable features explained in a walk-through manner. You'll also get to know the philos…

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question