如何使用具有动态范围的 VLOOKUP()？

Question

I am trying to get email adress from another Excel (let's call it EmployeesFile) file matching the same user id in EmployeesFile and in the file I am working with.

In the below code, this what I am trying to do.

Option Explicit

Public Sub getData()
    Dim pathKeys, pathEmployees As String
    pathKeys = openKeys
    pathEmployees = openEmployees
   
    If pathKeys <> "" Then
        Application.ScreenUpdating = False
        Dim wbKeys As Workbook
        Set wbKeys = GetObject(pathKeys)
        wbKeys.Worksheets(1).Columns(2).Copy Destination:=Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(1)
        wbKeys.Worksheets(1).Columns(3).Copy Destination:=Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(2)
        wbKeys.Worksheets(1).Columns(17).Copy Destination:=Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(3)
        wbKeys.Worksheets(1).Columns(19).Copy Destination:=Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(4)
        wbKeys.Worksheets(1).Columns(24).Copy Destination:=Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(5)
        wbKeys.Worksheets(1).Columns(25).Copy Destination:=Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(6)
        wbKeys.Worksheets(1).Columns(26).Copy Destination:=Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(7)
    End If
    
    
    If pathEmployees <> "" Then
        Dim wbEmployees As Workbook
        Dim cpt As Integer
        cpt = 1
        Set wbEmployees = GetObject(pathEmployees)
        Do Until IsEmpty(ActiveCell)
            Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(8) = "=VLOOKUP(RC[-3],wbEmployees.worksheets(1).columns("A1:G"&cpt),6)"
            cpt = cpt + 1
            ActiveCell.Offset(1, 0).Select
        Loop
    End If
    Application.ScreenUpdating = True
End Sub

I also use 2 public function to open differents files, here the code:

Public Function openKeys() As String
    Dim dialogBoxKeys As FileDialog
    Set dialogBoxKeys = Application.FileDialog(msoFileDialogFilePicker)

    MsgBox ("Sélectionnez le fichier Keys")
    With dialogBoxKeys
        .Title = "Keys File"
        .AllowMultiSelect = False
        .InitialFileName = "C:\"
        If .Show = -1 Then
            openKeys = .SelectedItems(1)
        End If
    End With
End Function

Public Function openEmployees() As String
    Dim dialogBoxEmployees As FileDialog
    Set dialogBoxEmployees = Application.FileDialog(msoFileDialogFilePicker)

    MsgBox ("Sélectionnez le fichier Employees")
    With dialogBoxEmployees
        .Title = "Employees File"
        .AllowMultiSelect = False
        .InitialFileName = "C:\"
        If .Show = -1 Then
            openEmployees = .SelectedItems(1)
        End If
    End With
End Function

I try to use cpt as a counter to loop every cells of email columns. In a static way Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).columns(8)= "=VLOOKUP(RC[-3],'Employees_2021-12-27_13_45_36_utf-8.csv':R2C1,R3332C7,6)" works perfectly.

However some vairables can change, as the range of the matrix and the name of the file. To get the name and path of the file, I don't have any troubles to do that.

Is there a way to use variables instead of static path + static range?

I want to learn from this, so, if possible, explain to me what I'm doing wrong here, or if my approach is lacking insight.

Answer 1

Please, try the next code. Not tested, but this is the idea for a fast solution. It avoids clipboard, uses only arrays and drops the arrays content at once:

Public Sub getData__()
    Dim wsK As Worksheet, wsMP As Worksheet, pathKeys As String, pathEmployees As String, arr, arrCols
    pathKeys = openKeys
    pathEmployees = openEmployees
    'setting the workbook to make the code more compact and easy to be read
    Set wsMP = Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1)
    If pathKeys <> "" Then
        'Application.ScreenUpdating = False 'no need of optimization...
        Dim wbKeys As Workbook
        Set wbKeys = GetObject(pathKeys)
        Set wsK = wbKeys.Worksheets(1) 'set the necessary sheet to easily use it in the next part
        
        arr = Intersect(wsK.UsedRange, wsK.Range("A:G")).Value 'Place the used range in an array
         arrCols = Application.Index(arr, Evaluate("row(1:" & UBound(arr) & ")"), Array(1, 2))  'extract the first two columns from the main array
        wsMP.Range("B1").Resize(UBound(arrCols), UBound(arrCols, 2)).Value = arrCols 'drop the content in B:C columns
        
        arrCols = Application.Index(arr, Evaluate("row(1:" & UBound(arr) & ")"), Array(3))
        wsMP.Range("Q1").Resize(UBound(arrCols), UBound(arrCols, 2)).Value = arrCols
        
        arrCols = Application.Index(arr, Evaluate("row(1:" & UBound(arr) & ")"), Array(4))
        wsMP.Range("S1").Resize(UBound(arrCols), UBound(arrCols, 2)).Value = arrCols
        
        arrCols = Application.Index(arr, Evaluate("row(1:" & UBound(arr) & ")"), Array(5, 6, 7))
        wsMP.Range("Y1").Resize(UBound(arrCols), UBound(arrCols, 2)).Value = arrCols
              
    End If
    
    If pathEmployees <> "" Then
        Dim wbEmployees As Workbook, wsE As Worksheet, rng As Range, rngLV As Range, arrV
        Set wbEmployees = GetObject(pathKeys)
        Set wsE = wbEmployees.Worksheets(1)
        Set rng = wsMP.Range("H1:H" & wsMP.Range("H" & wsMP.rows.Count).End(xlUp).row) 'set the range containing the lookup values
        Set rngLV = wsE.Range("A1:G" & wsE.Range("H" & wsE.rows.Count).End(xlUp).row)  'set the range containing the lookup area
        'place all range vllookup in an array
        arrV = WorksheetFunction.VLookup(rng, rngLV, 6, False)
          wsMP.Range("H1").Resize(UBound(arrV), UBound(arrV, 2)).Value = arrV   'drop the array content, at once
    End If
    Application.ScreenUpdating = True
End Sub