Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 53
  • Last Modified:

Performance enhancement

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
RIAS
Asked:
RIAS
  • 24
  • 14
1 Solution
 
skullnobrainsCommented:
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
 
Éric MoreauSenior .Net ConsultantCommented:
have you been able to identify which section of your method takes the most time?
0
 
RIASAuthor Commented:
Nope. How can I find it?
I am using vb.net 2015

Cheers
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
Éric MoreauSenior .Net ConsultantCommented:
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
 
RIASAuthor Commented:
Ok will try and get back
0
 
RIASAuthor Commented:
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
 
Éric MoreauSenior .Net ConsultantCommented:
when you say delays, how long does it take?

How many rows do you have in your datagrid?
0
 
RIASAuthor Commented:
I have around 3000 rows.
Compare to the rest of the sections .This is the one which takes longer.
0
 
Éric MoreauSenior .Net ConsultantCommented:
but how long? is is 1 second or 1 hour?
0
 
RIASAuthor Commented:
2 minutes
0
 
Éric MoreauSenior .Net ConsultantCommented:
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
 
RIASAuthor Commented:
Yes the fitst column is for selection
0
 
Éric MoreauSenior .Net ConsultantCommented:
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
 
RIASAuthor Commented:
Eric,
Will it work even when the datagridview is sorted?
0
 
Éric MoreauSenior .Net ConsultantCommented:
that I don't know, you will have to try but it should work since your are casting the datasource as a table.
0
 
RIASAuthor Commented:
Ok Eric will try and get back by tomorrow as I am away from the screen. Thanks
0
 
RIASAuthor Commented:
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
 
Éric MoreauSenior .Net ConsultantCommented:
how is your Sel column defined?
0
 
RIASAuthor Commented:
.Columns.Add("Sel", GetType(Object))
                .Columns("Sel").SetOrdinal(0)
0
 
RIASAuthor Commented:
But when I view the datatable the value in it is True/False
0
 
Éric MoreauSenior .Net ConsultantCommented:
>>.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
 
RIASAuthor Commented:
Ok,will try
0
 
RIASAuthor Commented:
Eric,
This change will make me change a lot of code.
Can we have a work around for object
0
 
Éric MoreauSenior .Net ConsultantCommented:
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
 
RIASAuthor Commented:
Ok,will try and get back.

Cheers!
0
 
RIASAuthor Commented:
Nope no luck still.
0
 
Éric MoreauSenior .Net ConsultantCommented:
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
 
RIASAuthor Commented:
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
 
RIASAuthor Commented:
It leaves one row less selected.I don't know why it is happening
0
 
Éric MoreauSenior .Net ConsultantCommented:
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
 
RIASAuthor Commented:
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
 
Éric MoreauSenior .Net ConsultantCommented:
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
 
RIASAuthor Commented:
Now since I have converted it to intger the values shows 0,1 in the sel column .
0
 
RIASAuthor Commented:
Do you want my datatable data ?
0
 
Éric MoreauSenior .Net ConsultantCommented:
I mean a self-contained app with the grid and fake data so that I don't have to create it by myself.
0
 
RIASAuthor Commented:
Just found something like:

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

Open in new window


Additional parameters
0
 
RIASAuthor Commented:
                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
 
RIASAuthor Commented:
Eric it worked with above code!

      Dg.DataSource.acceptchanges this was the key
0
 
RIASAuthor Commented:
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!

  • 24
  • 14
Tackle projects and never again get stuck behind a technical roadblock.
Join Now