Use File Browser to Import Data from Another Workbook

[talkinggoat]

I found the thread below, which works great, but I need to modify it to incorporate a variable range. In other words, my source range length will always change.

Use VBA to open file dialog and copy paste into current worksheet

Hello all, I am attempting to write a VBA to input data into a sheet I am working on. I am trying to input data into a spreadsheet that is currently set up so I need to paste data into the range D2:D195 in the current sheet. I would like to create a button that would allow me to pick a file...

www.mrexcel.com

I know I can use the following to determine the number of rows and columns, but how would I apply that to the source document? Sometimes I might need to select 300 lines, sometimes 30 or maybe 5 columns today and 9 tomorrow, depending on the document.

'// Determine the number of columns. 
    lcol = Cells.Find(what:="*", _ 
        after:=Range("a1"), _ 
        lookat:=xlPart, _ 
        LookIn:=xlFormulas, _ 
        searchorder:=xlByColumns, _ 
        SearchDirection:=xlPrevious, _ 
        MatchCase:=False).Column

'// Determine number of rows 
    lrow = Cells.Find(what:="*", _ 
        after:=Range("a1"), _ 
        lookat:=xlPart, _ 
        LookIn:=xlFormulas, _ 
        searchorder:=xlByRows, _ 
        SearchDirection:=xlPrevious, _ 
        MatchCase:=False).Row

 

[GWteB]

Sometimes I might need to select 300 lines, sometimes 30 or maybe 5 columns today and 9 tomorrow, depending on the document.

Does this mean you prefer a manual selection of the source range to be copied?

 

[talkinggoat]

Does this mean you prefer a manual selection of the source range to be copied?

No. Although I will always know my starting cell, the last cell will be variable, lrow, lcol.

 

[talkinggoat]

Sub insertFile() 
    Dim strFile As String 
    Dim wb As Workbook 
     
    With Application.FileDialog(3) 
        .AllowMultiSelect = False 
        If .Show Then 
            fullPath = .SelectedItems.Item(1) 
            Set wb = Workbooks.Open(fullPath) 
        End If 
        If wb Is Nothing Then Exit Sub 
         
        Set src = wb.Sheets(1) 
 
        lrow = src.Cells.Find(what:="*", _ 
        after:=Range("a1"), _ 
        lookat:=xlPart, _ 
        LookIn:=xlFormulas, _ 
        searchorder:=xlByRows, _ 
        SearchDirection:=xlPrevious, _ 
        MatchCase:=False).Row 
         
        lcol = src.Cells.Find(what:="*", _ 
        after:=Range("A1"), _ 
        lookat:=xlPart, _ 
        LookIn:=xlFormulas, _ 
        searchorder:=xlByColumns, _ 
        SearchDirection:=xlPrevious, _ 
        MatchCase:=False).Column 
         
        colLett = Split(Cells(1, lcol).Address, "$")(1) 
         
        src.Range("a1:" & colLett & lrow).Copy 
        ThisWorkbook.Worksheets("Sheet1").Activate 
        ActiveSheet.Range("A1").PasteSpecial 
        Application.CutCopyMode = False 
        wb.Close False 
    End With 
End Sub

Please let me know if there is a better way to do this.

 

[dmt32]

Hi,
try following update to your code & see if does what you want

Sub InsertFile()
    Dim RowCol(1 To 2)  As Long, i As Long
    Dim fullPath        As String
    Dim wb              As Workbook
    Dim src             As Worksheet
    Dim PasteRange      As Range
 
    Set PasteRange = ThisWorkbook.Worksheets("Sheet1").Range("A1")
 
    With Application.FileDialog(3)
        .AllowMultiSelect = False
        If .Show Then
            fullPath = .SelectedItems.Item(1)
            Application.ScreenUpdating = False
            Set wb = Workbooks.Open(fullPath)
        End If
    End With
 
    If wb Is Nothing Then Exit Sub
 
    Set src = wb.Sheets(1)
 
  
    For i = xlRows To xlColumns
        With src.Cells.Find(what:="*", After:=src.Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, _
             SearchOrder:=i, SearchDirection:=xlPrevious, MatchCase:=False)
            RowCol(i) = Choose(i, .Row, .Column)
        End With
    Next
 
    src.Cells(1, 1).Resize(RowCol(1), RowCol(2)).Copy PasteRange
 
    wb.Close False
 
    Application.ScreenUpdating = True
 
End Sub

Dave

 

[talkinggoat]

Doesn't xlRows and xlColumns only work if the data is continuous (no spaces)?

 

[GWteB]

Both xlRows and xlColumns are Excel constants (with successively the values 1 and 2) and probably used to make the code more readable.
Perhaps you should try the code provided by @dmt32 first and see if it solves your issue.

 

[dmt32]

Hi,

As already explained by @GWteB xlRows & xlColumns are just constants with values 1 & 2 respectively and is same as doing this:

For i = 1 to 2

Next i

Using constants in place of their numeric value makes code a little more readable.
By the creation of a simple loop using these values, we can store Row & Column values in an array
which allows more compact code to get both the row & column values.

I overlooked including some error handling if there is possibility of the sheet being blank

Sub InsertFile()
    Dim RowCol(1 To 2)  As Long, i As Long
    Dim fullPath        As String
    Dim wb              As Workbook
    Dim src             As Worksheet
    Dim PasteRange      As Range
 
    Set PasteRange = ThisWorkbook.Worksheets("Sheet1").Range("A1")
 
    With Application.FileDialog(3)
        .AllowMultiSelect = False
        If .Show Then
            fullPath = .SelectedItems.Item(1)
            Application.ScreenUpdating = False
            Set wb = Workbooks.Open(fullPath)
        End If
    End With
 
    If wb Is Nothing Then Exit Sub
 
    Set src = wb.Sheets(1)
 
    On Error Resume Next
    For i = xlRows To xlColumns
        With src.Cells.Find(what:="*", After:=src.Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, _
             SearchOrder:=i, SearchDirection:=xlPrevious, MatchCase:=False)
            RowCol(i) = Choose(i, .Row, .Column)
        End With
        If RowCol(i) = 0 Then RowCol(i) = 1
    Next
    On Error GoTo 0

    src.Cells(1, 1).Resize(RowCol(1), RowCol(2)).Copy PasteRange
 
    wb.Close False
 
    Application.ScreenUpdating = True
 
End Sub

Dave