none
Getting info from another file RRS feed

  • Question

  • Hi everyone,

    Hoping you can help.

    I get files from people where sometimes a certain cell isn't filled out and I need to get info from another file. I'm wondering if a macro could be used to get this?  I appreciate fully any help given.  Hopefullly this is easier in code that it is to explain! 

    Thank you.

    Here are the steps:

    • I open the received ABC file and I highlight cells I need to fill (always in rows, but could have more than 1 row selected - ie either cell a1, or could have cell a1:a5 highlighted for example)

    Macro kicks in:

    • Open separate file on my PC "XYZ"

    • Find the last row with a number in it in column B

    • Fill that cell down to continue the series by how many cells I have highlighted

    • Copy the new values from file XYZ

    • Paste values in the highlighted cells that were in the original sheet ABC

    • finally save and close XYZ

    Thursday, April 16, 2015 6:01 AM

Answers

  • Option Explicit
    
    Sub Test()
      Const MyFile = "c:\xyz.xlsx"
      Dim Here As Range, What As Range
      Dim Wb As Workbook, CloseIt As Boolean
      
      'Be sure the selection is valid!
      If Not TypeOf Selection Is Range Then
        MsgBox "Select a range of cells and try again"
        Exit Sub
      End If
      Set Here = Selection
      If Here.Areas.Count > 1 Then
        MsgBox "Select only one area of cells and try again"
        Exit Sub
      End If
      If Here.Columns.Count > 1 Then
        MsgBox "Select only cells in one column and try again"
        Exit Sub
      End If
      
      'Get or open the file
      Set Wb = GetWorkBook(MyFile)
      If Wb Is Nothing Then
        Set Wb = Workbooks.Open(MyFile)
        'Close it when it was closed
        CloseIt = True
      End If
      With Wb.ActiveSheet
        'Find the last row with a number in it in column B
        Set What = .Range("B" & .Rows.Count).End(xlUp)
        If What.Row + Here.Rows.Count > Rows.Count Then
          MsgBox "Too much rows!"
          Exit Sub
        End If
        'Fill that cell down to continue the series by how many cells I have highlighted
        What.Resize(Here.Rows.Count + 1).FillDown
        'Copy the new values from file XYZ
        What.Offset(1).Resize(Here.Rows.Count).Copy
        'Paste values in the highlighted cells that were in the original sheet ABC
        Here.PasteSpecial xlPasteValues
        'finally save and close XYZ
        If CloseIt Then Wb.Close SaveChanges:=True
      End With
    End Sub
    
    Private Function GetWorkBook(ByVal WorkBookName As String) As Workbook
      'Return the workbook that name is like WorkBookName, Nothing if not open
      Dim fso As Object 'FileSystemObject
      Set fso = CreateObject("Scripting.FileSystemObject")
      'Path given?
      If Len(fso.GetParentFolderName(WorkBookName)) > 0 Then
        'Compare the full path of each open workbook
        For Each GetWorkBook In Workbooks
          If StrComp(GetWorkBook.FullName, WorkBookName, vbTextCompare) = 0 Then
            Exit Function
          End If
        Next
      ElseIf InStrRev(WorkBookName, ".") > 0 Then
        'We must exact match if an extension is given
        On Error GoTo ExitPoint
        Set GetWorkBook = Workbooks(WorkBookName)
      Else
        'Without an extension it can be a new file too
        On Error GoTo SearchIt
        Set GetWorkBook = Workbooks(WorkBookName)
        Exit Function
    SearchIt:
        On Error GoTo ExitPoint
        If (InStr(WorkBookName, "?") > 0) Or (InStr(WorkBookName, "*") > 0) Then
          For Each GetWorkBook In Workbooks
            If fso.GetBaseName(GetWorkBook.Name) Like WorkBookName Then
              Exit Function
            End If
          Next
        Else
          For Each GetWorkBook In Workbooks
            If StrComp(fso.GetBaseName(GetWorkBook.Name), WorkBookName, vbTextCompare) = 0 Then
              Exit Function
            End If
          Next
        End If
      End If
    ExitPoint:
    End Function
    
    

    • Marked as answer by Justin1426 Sunday, April 19, 2015 2:09 AM
    Thursday, April 16, 2015 12:52 PM
  • a) yes, that's easy

    After the file is opened, the macro access the current (active) sheet:
      With Wb.ActiveSheet

    So when you want a specific sheet, use the Worksheets collection and pass the name of sheet as argument
      With Wb.Worksheets("Whatever")

    b) Theoretically yes, but in terms of a) no.

    If the file "Wb" is the active file and Worksheets("Whatever") is the active sheet, then (and only then!) you can select any cell(s) you like.

    But please never use SELECT, SELECTION, ACTIVATE, it is slow and error prone. Always refer to the objects directly.

    Andreas.

    • Marked as answer by Justin1426 Sunday, April 19, 2015 2:09 AM
    Friday, April 17, 2015 7:39 AM

All replies

  • Option Explicit
    
    Sub Test()
      Const MyFile = "c:\xyz.xlsx"
      Dim Here As Range, What As Range
      Dim Wb As Workbook, CloseIt As Boolean
      
      'Be sure the selection is valid!
      If Not TypeOf Selection Is Range Then
        MsgBox "Select a range of cells and try again"
        Exit Sub
      End If
      Set Here = Selection
      If Here.Areas.Count > 1 Then
        MsgBox "Select only one area of cells and try again"
        Exit Sub
      End If
      If Here.Columns.Count > 1 Then
        MsgBox "Select only cells in one column and try again"
        Exit Sub
      End If
      
      'Get or open the file
      Set Wb = GetWorkBook(MyFile)
      If Wb Is Nothing Then
        Set Wb = Workbooks.Open(MyFile)
        'Close it when it was closed
        CloseIt = True
      End If
      With Wb.ActiveSheet
        'Find the last row with a number in it in column B
        Set What = .Range("B" & .Rows.Count).End(xlUp)
        If What.Row + Here.Rows.Count > Rows.Count Then
          MsgBox "Too much rows!"
          Exit Sub
        End If
        'Fill that cell down to continue the series by how many cells I have highlighted
        What.Resize(Here.Rows.Count + 1).FillDown
        'Copy the new values from file XYZ
        What.Offset(1).Resize(Here.Rows.Count).Copy
        'Paste values in the highlighted cells that were in the original sheet ABC
        Here.PasteSpecial xlPasteValues
        'finally save and close XYZ
        If CloseIt Then Wb.Close SaveChanges:=True
      End With
    End Sub
    
    Private Function GetWorkBook(ByVal WorkBookName As String) As Workbook
      'Return the workbook that name is like WorkBookName, Nothing if not open
      Dim fso As Object 'FileSystemObject
      Set fso = CreateObject("Scripting.FileSystemObject")
      'Path given?
      If Len(fso.GetParentFolderName(WorkBookName)) > 0 Then
        'Compare the full path of each open workbook
        For Each GetWorkBook In Workbooks
          If StrComp(GetWorkBook.FullName, WorkBookName, vbTextCompare) = 0 Then
            Exit Function
          End If
        Next
      ElseIf InStrRev(WorkBookName, ".") > 0 Then
        'We must exact match if an extension is given
        On Error GoTo ExitPoint
        Set GetWorkBook = Workbooks(WorkBookName)
      Else
        'Without an extension it can be a new file too
        On Error GoTo SearchIt
        Set GetWorkBook = Workbooks(WorkBookName)
        Exit Function
    SearchIt:
        On Error GoTo ExitPoint
        If (InStr(WorkBookName, "?") > 0) Or (InStr(WorkBookName, "*") > 0) Then
          For Each GetWorkBook In Workbooks
            If fso.GetBaseName(GetWorkBook.Name) Like WorkBookName Then
              Exit Function
            End If
          Next
        Else
          For Each GetWorkBook In Workbooks
            If StrComp(fso.GetBaseName(GetWorkBook.Name), WorkBookName, vbTextCompare) = 0 Then
              Exit Function
            End If
          Next
        End If
      End If
    ExitPoint:
    End Function
    
    

    • Marked as answer by Justin1426 Sunday, April 19, 2015 2:09 AM
    Thursday, April 16, 2015 12:52 PM
  • This code is absolutely amazing, I don't know how I can thank you enough???  I can't believe all the effort put into that.

    Do you mind if I ask 2 further questions?  First, is there a way to specify that it should only look on  "Sheet1" inside  XYZ file?  Secondly, can the "focus" (I believe is the term), be set so that before the file is closed and saved, that the highlighted cell goes to the last value in column B?

    Friday, April 17, 2015 5:56 AM
  • a) yes, that's easy

    After the file is opened, the macro access the current (active) sheet:
      With Wb.ActiveSheet

    So when you want a specific sheet, use the Worksheets collection and pass the name of sheet as argument
      With Wb.Worksheets("Whatever")

    b) Theoretically yes, but in terms of a) no.

    If the file "Wb" is the active file and Worksheets("Whatever") is the active sheet, then (and only then!) you can select any cell(s) you like.

    But please never use SELECT, SELECTION, ACTIVATE, it is slow and error prone. Always refer to the objects directly.

    Andreas.

    • Marked as answer by Justin1426 Sunday, April 19, 2015 2:09 AM
    Friday, April 17, 2015 7:39 AM
  • Thank you again, I really appreciate the help!
    Sunday, April 19, 2015 2:09 AM