Import Excel workbook and output some rows & columns based on a condition

Question

I am trying to use VBA to ask someone to select an Excel file and, if the file meets the criteria, I want to output certain columns to a new workbook.

I started by creating the script that allows the user select a file and then just tried testing if I could see some data output but I am at a loss. My logic seems way off! I have provided the code below. It may not seem to make much sense but, before I derailed, my idea was:

User opens Excel file (which the macro is within)
When the script is run, the browse panel opens to select an Excel file
If that Excel file (workbook) contains the string in cell 8 (also looping through), then output the range of columns in a new workbook.

Here's the code:

Sub Import2()
Dim Input_Workbook As Workbook
Dim Output_Workbook As Workbook
Dim Source_Path As String
Dim LastRow As Long, erow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Source_Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS*), *.XLS*", Title:="Select File To Be Opened")

Set Input_Workbook = Workbooks.Open(Source_Path)

For i = 2 To LastRow
    If Cells(i, 8) = "231/8151" Then
        Range(Cells(i, 1), Cells(i, 7)).Select
        Selection.Copy
        Set Output_Workbook = ThisWorkbook
        Set Input_Workbook = Workbooks.Open(Source_Path)
        Imported_Workbook.Sheets(1).Select
        erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

        Input_Workbook.Cells(erow, 1).Select
        Input_Workbook.Paste
        Input_Workbook.Save
        Input_Workbook.Close
        Input_Workbook = False
    End If

    Output_Workbook.Save
    Input_Workbook.Save
    Input_Workbook.Close False

Next i
End Sub

score 1 · Answer 1 · edited May 23 '17 at 12:30

It seems you've interchanged your input and output workbooks. You're approach in opening a workbook is correct, however you need to anticipate the user Cancelling or Closing the dialogue box.

Dim Source_Path As Variant ' Declare as Variant and not as string
Source_Path = Application.GetOpenFileName("Excel Files (*.xls*), *.xls*", , _
                                          "Select File To Be Opened", ,True)

If Not IsArray(Source_Path) Then Msgbox "No File Selected. Exiting Now": Exit Sub

Now take care of your input and output workbook.

Dim Input_Workbook As Workbook, Output_Workbook As Workbook
Set Output_Workbook = ThisWorkbook: Set Input_Workbook = Workbooks.Open(Source_Path)

Now which sheet do you need to check in Input_Workbook?
I'll assume you only have one worksheet so:

Dim what_to_find As String, found_rng As Range
Dim LastRow As Long

Dim Output_Worksheet As Worksheet: Set Output_Worksheet = Output_Workbook.Sheets(1)
what_to_find = "231/8151"

With Input_Workbook.Sheets(1)
    Set found_rng = .Range("H:H").Find(what_to_find) 'execute find first
    If found_rng Is Nothing Then MsgBox "No Match Found. Exiting Now.": Exit Sub
    LastRow = .Range("H" & .Rows.Count).End(xlup).Row
    ' Now, an alternative to looping is using AutoFilter Method
    .Range("A1:H" & LastRow).AutoFilter 8, what_to_find ' filter all matches
    .Range("A2:G" & LastRow).SpecialCells(xlCellTypeVisible).Copy

    Output_Worksheet.Range("A" & Output_Worksheet.Rows.Count).End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues ' or xlPasteAll
End With

Other assumptions include:

You're really matching or searching a text or string and not formula or part of it.
You need to copy the values, not formulas. Otherwise, use xlPasteAll

Also, check this out to know ways on how to avoid using Select and familiarize yourself on working with objects. You're actually pretty close, you just get confused in the copying and pasting part in the loop. Hope this and the link I've recommended guide you to make your code work and help you accomplish what you need.

Import Excel workbook and output some rows & columns based on a condition

1 Answers1