Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Performance enhancement

Posted on 2016-10-19
39
Medium Priority
?
50 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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
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 2000 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: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

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

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 …
Microsoft Reports are based on a report definition, which is an XML file that describes data and layout for the report, with a different extension. You can create a client-side report definition language (*.rdlc) file with Visual Studio, and build g…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Please read the paragraph below before following the instructions in the video — there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, …
Suggested Courses

610 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