Solved

Performance enhancement

Posted on 2016-10-19
39
32 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
  • 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
Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

 
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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Exit the loop 4 49
VB 2005 Tooltips on Form Load Event 15 34
Help with preventing selection from a combobox 11 34
System.net.Sockets Error 5 26
This article explains how to create and use a custom WaterMark textbox class.  The custom WaterMark textbox class allows you to set the WaterMark Background Color and WaterMark text at design time.   IMAGE OF WATERMARKS STEPS Create VB …
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…
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

789 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