none
xlsx filtered range import using interop help RRS feed

  • Question

  • Hey All,

    I am having some issues trying to get the autofilter/filtered range to work. I am trying to apply a filter and then used that filtered range to add rows to datatable RAW. I'm not sure how to accomplish this. Any help would be much appreciated. Code below.

        Public Sub TESTER()
            Dim xlApp2 As Excel.Application = Nothing
            Dim xlWorkBooks2 As Excel.Workbooks = Nothing
            Dim xlWorkBook2 As Excel.Workbook = Nothing
            Dim xlWorkSheet2 As Excel.Worksheet = Nothing
            Dim xlWorkSheets2 As Excel.Sheets = Nothing
            Dim xlApp3 As Excel.Application = Nothing
            Dim xlWorkBooks3 As Excel.Workbooks = Nothing
            Dim xlWorkBook3 As Excel.Workbook = Nothing
            Dim xlWorkSheet3 As Excel.Worksheet = Nothing
            Dim xlWorkSheets3 As Excel.Sheets = Nothing
            Dim fileName2 As String = IO.Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "2018RAW.xlsx")
            Dim fileName3 As String = IO.Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "2019RAW.xlsx")
            Dim counta As Integer
            Dim countb As Integer
            Dim RAW As New DataTable
    
            TextBox2.Text = "2018RAW"
            counta = 0
            countb = 0
            xlApp2 = New Excel.Application
            xlApp2.Visible = False
            xlApp2.DisplayAlerts = False
            xlWorkBooks2 = xlApp2.Workbooks
            xlWorkBook2 = xlWorkBooks2.Open(fileName2)
            xlWorkSheets2 = xlWorkBook2.Sheets
            xlWorkSheet2 = xlWorkBook2.Sheets("2018RAW")
            counta = xlWorkSheet2.UsedRange.Rows.Count()
            countb = xlWorkSheet2.UsedRange.Columns.Count()
    
            ProgressBar1.Value = 0
            ProgressBar1.Maximum = 33 + counta
    
            Dim top_left = xlWorkSheet2.Cells(2, 1)
            Dim bottom_right = xlWorkSheet2.Cells(counta, 33)
            Dim range = xlWorkSheet2.Range(top_left, bottom_right)
            range.AutoFilter(21, Form3.Label1.Text, Excel.XlAutoFilterOperator.xlFilterValues, Type.Missing, True)
            Dim srange = range.SpecialCells(Excel.XlCellType.xlCellTypeVisible, Excel.XlSpecialCellsValue.xlTextValues)
            Dim values As Object(,) = CType(srange.Value2, Object(,))
            counta = srange.Rows.Count()
    
            Label2.Text = "Parsing Data, please wait......"
            For i As Integer = 1 To 33
                TextBox2.Text = "Adding Column " & xlWorkSheet2.Cells(1, i).value.ToString
                RAW.Columns.Add(xlWorkSheet2.Cells(1, i).value.ToString)
                'Form3.DataGridView1.Columns.Add(i, xlWorkSheet2.Cells(1, i).value.ToString)
                ProgressBar1.Value = ProgressBar1.Value + 1
            Next
    
            Dim t(32) As Object
    
            For row = 1 To counta
                If CStr(xlWorkSheet2.Cells(row, 21).value) = Form3.Label1.Text Then
                    For col = 1 To 33
                        t(col - 1) = values(row, col)
                    Next
                    TextBox2.Text = "Row " & row
                    RAW.Rows.Add(t)
                    ProgressBar1.Value = ProgressBar1.Value + 1
                Else
                    TextBox2.Text = "Row " & row
                    ProgressBar1.Value = ProgressBar1.Value + 1
                End If
            Next
            Form3.DataGridView1.DataSource = RAW
            TextBox2.Text = ""
            Label2.Text = "Loading Complete!"
    End Sub

    Sunday, January 13, 2019 1:49 PM

Answers

  • Hi K7:

    If I'm understanding your need correctly, I think your code may be more difficult than it needs to be. I may be way off-base but here we go...

    I tried to put an example below. This example filters on 4 of 10 columns. I typically capture my Range of data with variables to better manage my code (i.e. lastRow, lastCol) and the same with column numbers and their actual header names (CODE, MAP, ID, PHONE). I would also recommend using a For/Next to capture the "Bottom_Right" as the "UsedRange" is unstable, and has been for years. Its been known to not clear and refresh properly if your codes uses it more than once, skewing your results.

    The first part will select your worksheet, the range of data to be filtered (With statement) then each column in order and what to filter. "<>" means remove blanks and "=" means to only include blanks. The Array is filtering all the numerical values BUT you must include the "xlFilterValues" parameter or it will not work.

    Next, within the "On Error" wrapper, this will copy only the filtered data, BUT YOU MUST REFERENCE the full data range. The pasting part of the code will then paste it all within the workbook, sheet, range you specify. In this case, this code finds the last blank row of data on Sheet2 and pastes all the data. The example counts rows in Column "E" because in the data, that was the only column that would not have blanks, then the offset makes sure the data is copied to the first blank row of Column A and not E. The purpose of the "On Error" wrapper is that your filtering may result in nothing.

            Worksheets(1).Activate
            With Sheets(1).Range(Cells(1, 1), Cells(lastRow, lastCol))
                .AutoFilter CODE, "DISB"
                .AutoFilter MAP, "<>"
                .AutoFilter ID, Array("17", "21", "57", "70", "97"), xlFilterValues
                .AutoFilter PHONE, "="
            End With
    
            DoEvents
            
            On Error Resume Next
            Sheets(1).Range(Cells(2, 1), Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Copy _
                Destination:=Sheets(2).Range("E" & Rows.Count).End(xlUp).Offset(1, -4)
            On Error GoTo 0

    So I think yours will be similar to this. I assumed "Form3.Label1.Text" was an array of values to filter (I don't think what I put there will work correctly, you may need enter those values within the array more with a "Split" statement ( e.g. Split(Form3,Label1.Text, ",") ).

    The second part will copy all filtered data starting with A2 to your full range right corner, and I like using Cells vs Range, Cells(counta, countb). You may need to adjust the destination. I used the offset to make sure to paste data to the last row, so you add 1 (1, 0) and to the the correct column, 0 means no change to column placement (remains at A or (1, 0)).

    It is good to perform a "DoEvents" so your filtering doesn't cause "Not Responding". Just a safety net to prevent crashing.

            Worksheets(1).Activate
            With Sheets(1).Range(Cells(1, 1), Cells(counta, countb))
                .AutoFilter 21, Array(Form3.Label1.Text), xlFilterValues  
            End With
    
            DoEvents
            
            On Error Resume Next
            Sheets(1).Range(Cells(2, 1), Cells(counta, countb)).SpecialCells(xlCellTypeVisible).Copy _
                Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            On Error GoTo 0


    SV





    • Edited by svMSDN Monday, January 14, 2019 2:03 PM
    • Marked as answer by k7s41gx Tuesday, January 22, 2019 3:33 PM
    Monday, January 14, 2019 1:53 PM

All replies

  • Hi,

    You can try my code:

      

    Imports Excel1 = Microsoft.Office.Interop.Excel

    Private Function GetDataFromExcelByCom(ByVal Optional hasTitle As Boolean = False) As DataTable Dim excelFilePath = "C:\Users\alexl2\Desktop\Excel.xlsx" Dim app As Excel1.Application = New Excel1.Application() Dim sheets As Excel1.Sheets Dim oMissiong As Object = System.Reflection.Missing.Value Dim workbook As Excel1.Workbook = Nothing Dim dt As DataTable = New DataTable() Try If app Is Nothing Then Return Nothing workbook = app.Workbooks.Open(excelFilePath, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong, oMissiong) sheets = workbook.Worksheets Dim worksheet As Excel1.Worksheet = sheets(1) Dim ji As Integer = CType(12, Integer) If worksheet Is Nothing Then Return Nothing Dim iRowCount As Integer = worksheet.UsedRange.Rows.Count Dim iColCount As Integer = worksheet.UsedRange.Columns.Count For i As Integer = 0 To iColCount - 1 Dim name = "column" & i If hasTitle Then Dim txt = (CType(worksheet.Cells(1, i + 1), Excel1.Range)).Text.ToString() If Not String.IsNullOrWhiteSpace(txt) Then name = txt End If While dt.Columns.Contains(name) name = name & "_1" End While dt.Columns.Add(New DataColumn(name, GetType(String))) Next Dim range As Excel1.Range Dim rowIdx As Integer = If(hasTitle, 2, 1) For iRow As Integer = rowIdx To iRowCount Dim dr As DataRow = dt.NewRow() For iCol As Integer = 1 To iColCount range = CType(worksheet.Cells(iRow, iCol), Excel1.Range) dr(iCol - 1) = If((range.Value2 Is Nothing), "", range.Text.ToString()) Next If dr("columnName") = "xxx" Then dt.Rows.Add(dr) End If Next Return dt Catch Return Nothing Finally workbook.Close(False, oMissiong, oMissiong) System.Runtime.InteropServices.Marshal.ReleaseComObject(workbook) workbook = Nothing app.Workbooks.Close() app.Quit() System.Runtime.InteropServices.Marshal.ReleaseComObject(app) app = Nothing End Try End Function

    Best Regards,

    Alex


    MSDN Community Support Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, January 14, 2019 2:43 AM
  • Hi K7:

    If I'm understanding your need correctly, I think your code may be more difficult than it needs to be. I may be way off-base but here we go...

    I tried to put an example below. This example filters on 4 of 10 columns. I typically capture my Range of data with variables to better manage my code (i.e. lastRow, lastCol) and the same with column numbers and their actual header names (CODE, MAP, ID, PHONE). I would also recommend using a For/Next to capture the "Bottom_Right" as the "UsedRange" is unstable, and has been for years. Its been known to not clear and refresh properly if your codes uses it more than once, skewing your results.

    The first part will select your worksheet, the range of data to be filtered (With statement) then each column in order and what to filter. "<>" means remove blanks and "=" means to only include blanks. The Array is filtering all the numerical values BUT you must include the "xlFilterValues" parameter or it will not work.

    Next, within the "On Error" wrapper, this will copy only the filtered data, BUT YOU MUST REFERENCE the full data range. The pasting part of the code will then paste it all within the workbook, sheet, range you specify. In this case, this code finds the last blank row of data on Sheet2 and pastes all the data. The example counts rows in Column "E" because in the data, that was the only column that would not have blanks, then the offset makes sure the data is copied to the first blank row of Column A and not E. The purpose of the "On Error" wrapper is that your filtering may result in nothing.

            Worksheets(1).Activate
            With Sheets(1).Range(Cells(1, 1), Cells(lastRow, lastCol))
                .AutoFilter CODE, "DISB"
                .AutoFilter MAP, "<>"
                .AutoFilter ID, Array("17", "21", "57", "70", "97"), xlFilterValues
                .AutoFilter PHONE, "="
            End With
    
            DoEvents
            
            On Error Resume Next
            Sheets(1).Range(Cells(2, 1), Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Copy _
                Destination:=Sheets(2).Range("E" & Rows.Count).End(xlUp).Offset(1, -4)
            On Error GoTo 0

    So I think yours will be similar to this. I assumed "Form3.Label1.Text" was an array of values to filter (I don't think what I put there will work correctly, you may need enter those values within the array more with a "Split" statement ( e.g. Split(Form3,Label1.Text, ",") ).

    The second part will copy all filtered data starting with A2 to your full range right corner, and I like using Cells vs Range, Cells(counta, countb). You may need to adjust the destination. I used the offset to make sure to paste data to the last row, so you add 1 (1, 0) and to the the correct column, 0 means no change to column placement (remains at A or (1, 0)).

    It is good to perform a "DoEvents" so your filtering doesn't cause "Not Responding". Just a safety net to prevent crashing.

            Worksheets(1).Activate
            With Sheets(1).Range(Cells(1, 1), Cells(counta, countb))
                .AutoFilter 21, Array(Form3.Label1.Text), xlFilterValues  
            End With
    
            DoEvents
            
            On Error Resume Next
            Sheets(1).Range(Cells(2, 1), Cells(counta, countb)).SpecialCells(xlCellTypeVisible).Copy _
                Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            On Error GoTo 0


    SV





    • Edited by svMSDN Monday, January 14, 2019 2:03 PM
    • Marked as answer by k7s41gx Tuesday, January 22, 2019 3:33 PM
    Monday, January 14, 2019 1:53 PM