Creating an Excel user-defined function to look up another workbook and return an array spilling ove-CodePudding

Suppose I have two workbooks in the same folder: TargetFile and SourceFile, where the function GetTwoLines() is saved in TargetFile.

I would like to fix the code of the function GetTwoLines() in order to search the SourceFile for the cell content whose address is passed to the function.

After finding the row number in SourceFile, I need to:

1- get the content of the cell .Range("B" & RowNum 1) in SourceFile

2- if the cell content has two lines (i.e. there is a line break), the first line should be stored in FirstLine and returned to the calling cell while storing the second line in SecondLine and returning it to the right neighbor cell of the calling cell.

3- if there is no line break, FirstLine should be returned to the calling cell while returning empty SecondLine to the right neighbor cell of the calling cell.

Function GetTwoLines(Title As Range)
    
    Dim FirstLine, SecondLine As String, RowNum As Long
    Dim FolderPath As String: FolderPath = ThisWorkbook.Path
    Dim TargetFile As Workbook: Set TargetFile = ThisWorkbook
    Dim SheetName As String: SheetName = ThisWorkbook.ActiveSheet.Name
    
    Dim SourceFile As Workbook
    
    With CreateObject("Excel.application")
        Set SourceFile = .Workbooks.Open(FolderPath & "/Source.xlsm")
    End With
    
    Dim SourceFileSearchRange As Range
    Set SourceFileSearchRange = SourceFile.Sheets(SheetName).Range("B1:B400")
    
    RowNum = WorksheetFunction.XMatch(Trim(Title.Value), SourceFileSearchRange, 0)

    'After finding the row number, I need to:
    
    '1- Get the content of the cell .Range("B" & RowNum   1)
    '
    '2- if the cell content has two lines (i.e. there is a line break), 
    'the first line should be stored in `FirstLine` and returned to the calling cell 
    'while storing the second line in `SecondLine` and returning it to the right neighbor cell of the calling cell.

    '3- if there is no line break, `FirstLine` should be returned to the calling cell 
    'while returning empty `SecondLine` to the right neighbor cell of the calling cell.

End Function

I need to use the function as a UDF. For example, in some cell in TargetFile, I need to write in the formula bar =GetTwoLines(C4), where C4 is a TargetFile cell whose content is used by the function to get the two-line content of the cell .Range("B" & RowNum 1) in SourceFile.

CodePudding user response：

Please, use the next adapted function. It can be called as UDF and returns an array. Only in this way it may affect other cell except the one where it has been called. And being a UDF function, it cannot open a workbook in the same session, indeed:

Function GetTwoLines(Title As Range) As Variant
    Dim FirstLine, SecondLine As String, RowNum As Variant 'mandatory to be Variant, in case of no match
    Dim FolderPath As String: FolderPath = ThisWorkbook.path
    
    Dim SourceFile As Workbook, SheetName As String
    
    Dim objExcel As Object
    Set objExcel = CreateObject("Excel.application")

       Set SourceFile = objExcel.Workbooks.Open(FolderPath & "\Source.xlsm")

       SheetName = Title.Parent.name 'the sheet where the range exists
    
       Dim SourceFileSearchRange As Range
       Set SourceFileSearchRange = SourceFile.Sheets(SheetName).Range("B1:B400")
    
       RowNum = Application.match(Trim(Title.value), SourceFileSearchRange, 0)
    
      Dim arrSpl
      If IsNumeric(RowNum) Then
          arrSpl = Split(SourceFileSearchRange.cells(RowNum   1, 1).value, vbLf)
         If UBound(arrSpl) > 0 Then
            GetTwoLinesSameSess = Array(arrSpl(0), arrSpl(1)) 'if more than 2 rows, it returns only the first two...
         ElseIf UBound(arrSpl) = 0 Then
            GetTwoLinesSameSess = Array(arrSpl(0), "")
        Else
            GetTwoLinesSameSess = Array("", "Empty cell...")
         End If
      Else
         objExcel.Visible = True
         MsgBox Title.value & " could not be found in ""B1:B400"" range..."
         GetTwoLines = Array("", "not a match")
      End If
      SourceFile.Close False: objExcel.Quit
End Function

It can be called as UDF in the next (required) way:

  =GetTwoLines(C4)

Of course, in "C4" cell the string to be searched in the source file range...

Edited:

Please, use the next version which will work with the target workbook already open in Excel (the same session):

Function GetTwoLinesSameSess(Title As Range) As Variant
    Dim FirstLine, SecondLine As String, RowNum As Variant
    Dim FolderPath As String: FolderPath = ThisWorkbook.path
    
    Dim SourceFile As Workbook, SheetName As String
    
    On Error Resume Next
       Set SourceFile = Workbooks("Source.xlsm") 'set it if open already...
    On Error GoTo 0
    If SourceFile Is Nothing Then
            MsgBox "The source file is not open...", vbCritical, "No source file open"
            GetTwoLinesSameSess = Array("", "No source file..."): Exit Function
    End If
    
    SheetName = Title.Parent.name 'the sheet where the range exists
    
    Dim SourceFileSearchRange As Range
    Set SourceFileSearchRange = SourceFile.Sheets(SheetName).Range("B1:B400")
    
    RowNum = Application.match(Trim(Title.value), SourceFileSearchRange, 0)
    
   Dim arrSpl
   If IsNumeric(RowNum) Then
         arrSpl = Split(SourceFileSearchRange.cells(RowNum   1, 1).value, vbLf)
         If UBound(arrSpl) > 0 Then
            GetTwoLinesSameSess = Array(arrSpl(0), arrSpl(1)) 'if more than 2 rows, it returns only the first two...
         ElseIf UBound(arrSpl) = 0 Then
            GetTwoLinesSameSess = Array(arrSpl(0), "")
        Else
            GetTwoLinesSameSess = Array("", "Empty cell...")
         End If
   Else
        MsgBox Title.value & " could not be found in ""B1:B400"" range..."
        GetTwoLinesSameSess = Array("", "not found string...")
   End If
End Function