Select Workbook and Worksheet in Vlookup Macro

[tinydancer]

I have a macro that runs a vlookup. It's tailored not to overwrite cells that already have text in them and only carry over found values to blank cells. At the moment it simply goes looking for these values on another sheet in the same workbook called "Lookup_Sheet".

Sub Vlookup44()                                                                                                                 
Dim i As Integer                                                                                                                
Dim stVal As String                                                                                                             
Dim lastRow As Long                                                                                                            
On Error GoTo err_handler                                                                                                      
lastRow = Range("E" & Rows.Count).End(xlUp).Row                                                                                 
For i = 2 To lastRow                                                                                                           
    If IsEmpty(Range("Q" & i)) Then                                                                                            
        stVal = Application.WorksheetFunction.Vlookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 13, False)     
        On Error Resume Next                                                                                                   
        Range("Q" & i) = stVal                                                                                                 
    End If                                                                                                                     
    
    If IsEmpty(Range("R" & i)) Then
        stVal = Application.WorksheetFunction.Vlookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 14, False)
        On Error Resume Next
        Range("R" & i) = stVal
    End If
    
    If IsEmpty(Range("S" & i)) Then
        stVal = Application.WorksheetFunction.Vlookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 15, False)
        On Error Resume Next
        Range("S" & i) = stVal
    End If
    
    If IsEmpty(Range("T" & i)) Then
        stVal = Application.WorksheetFunction.Vlookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 16, False)
        On Error Resume Next
        Range("T" & i) = stVal
    End If
Next
Exit Sub
err_handler:
    MsgBox Err.Description
End Sub

What I want is to be able to run the code and let me select the file the vlookup pulls from. Essentially it would take me to My Computer and I would click on the excel workbook I want and then I would select the exact worksheet that I want to use for the vlookup. I would really appreciate any and all help I can get on this one.

 

[gallen]

This is achievable however it will require you to know the sheet name and range. Will the sheet name always be "Lookup_Sheet"? and will it always be the same range?

 

[tinydancer]

The workbooks to be picked from will all have different names but the sheet name within all of the workbooks will always be the same. So "Lookup_Sheet" will be in a variety of workbooks and all contain different data. The lookup range will be the same as well.

 

[dmt32]

The workbooks to be picked from will all have different names but the sheet name within all of the workbooks will always be the same. So "Lookup_Sheet" will be in a variety of workbooks and all contain different data. The lookup range will be the same as well.

Hi,
just so I understand, in each workbook you open the sheet name will always be "Lookip_Sheet"?
What is the name of the sheet in the workbook you are returning data to?

Dave

 

[gallen]

Edit: paste was corrupt, will try again

 

[gallen]

Here is your revised sub. I could only get it to work without using the application.worksheetfunction. Instead I had to create a cell named "_Result" and set the formula of that cell to get the result.

This will prompt you for your file and then get the info you need: Please note I've only done it for the first part of your sub. You can use the syntax to complete it.

Sub Vlookup44()
Dim i As Integer
Dim stVal As String
Dim lastRow As Long


Dim sPath As String, sfileName As String, s As String


'Only way I know of doing it without opening the workbook:
'You set a cell (can be hidden) as the "Results" cell. This will hold the vLookUp info you are after.


On Error GoTo err_handler
lastRow = Range("E" & Rows.Count).End(xlUp).Row


'*********************----GET WORKBOOK PATH---***********************
sPath = GetFile("C:\Test", "Select") 'change these values as needed.*
i = InStrRev(sPath, "\") '                                          *
sfileName = Right(sPath, Len(sPath) - i) '                          *
sPath = Left(sPath, Len(sPath) - Len(sfileName)) '                  *
'********************************************************************


For i = 2 To lastRow
    If IsEmpty(Range("Q" & i)) Then
    
        '**************************************************ENTER RESULT INTO CELL THEN USE RESULT****************************************
    
        s = "=VLOOKUP(""" & Range("E" & i).Value & """,'" & sPath & "[" & sfileName & "]" & "Lookup_Sheet'!" & "E:T, 13, FALSE)"
        Range("_Result").Formula = s
        stVal = IIf(IsError(Range("_Result").Value), "Not Found", Range("_Result").Value)
        
        '********************************************************************************************************************************
        'Old line commented out stVal = Application.WorksheetFunction.VLookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 13, False)
        On Error Resume Next
        Range("Q" & i) = stVal
    End If
    
    If IsEmpty(Range("R" & i)) Then
        stVal = Application.WorksheetFunction.VLookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 14, False)
        On Error Resume Next
        Range("R" & i) = stVal
    End If
    
    If IsEmpty(Range("S" & i)) Then
        stVal = Application.WorksheetFunction.VLookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 15, False)
        On Error Resume Next
        Range("S" & i) = stVal
    End If
    
    If IsEmpty(Range("T" & i)) Then
        stVal = Application.WorksheetFunction.VLookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 16, False)
        On Error Resume Next
        Range("T" & i) = stVal
    End If
Next
Exit Sub
err_handler:
    MsgBox Err.Description
End Sub

You will also need to add this function to your code window:

Public Function GetFile(Optional InitialFolder As String, Optional ButtonName As String) As String

'Function to return full path of file.
Dim dlgFolder As FileDialog
Set dlgFolder = Application.FileDialog(msoFileDialogOpen)
    If InitialFolder = "" Then InitialFolder = "C:\" 'deafult to C drive
    With dlgFolder
        .InitialFileName = InitialFolder
        .Title = "Please Select Workbook"
        If ButtonName <> "" Then .ButtonName = ButtonName
        If .Show = -1 Then 'user has selected a folder
            GetFile = .SelectedItems(1)
        Else
            GetFile = ""
        End If
    End With
End Function

 

[tinydancer]

@dmt32 yes that is correct, and the other sheet name will always be "Current_Week".

@gallen I was having some trouble with your code, it still doesn't run. Where exactly do I put the second part of the code? Maybe that has something to do with it.

 

[dmt32]

@dmt32 yes that is correct, and the other sheet name will always be "Current_Week".

@gallen I was having some trouble with your code, it still doesn't run. Where exactly do I put the second part of the code? Maybe that has something to do with it.

Not tested but give this a try and see if does what you want:

Sub Test()
    Dim wb As Workbook
    Dim wsSource As Worksheet
   
   On Error GoTo err_handler
    If FileIsOpen(wb) Then
        Set wsSource = wb.Sheets("Lookup_Sheet")
        Vlookup44 wsSource
        ThisWorkbook.Activate
        wb.Close False
    End If
    
err_handler:
    Application.ScreenUpdating = True
    If Err > 0 Then MsgBox (Error(Err)), 16, "Error"
End Sub


Function FileIsOpen(ByRef wb As Workbook) As Boolean


    Dim FileName As Variant
    Dim Filter As String
    Dim Index As Integer
    
    Index = IIf(Application.Version < 12, 1, 2)
    
    Filter = "Workbooks 2003 (*.xls),*.xls," & _
              "Workbooks 2007 > (*.xlsx),*.xlsx," & _
              "Workbooks 2007 > (Macro Enabled) (*.xlsm),*.xlsm," & _
              "All Excel Files (*.xl*),*.xl*," & _
              "All Files (*.*),*.*"


    FileName = Application.GetOpenFilename(Filter, Index, "Open Source Workbook")


    If FileName = False Then Exit Function
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(FileName)
    FileIsOpen = True
End Function


Sub Vlookup44(ByVal sh As Object)
    Dim stVal As Variant
    Dim lastRow As Long, i As Long
    Dim wsCurrentWeek As Worksheet
    
    Set wsCurrentWeek = ThisWorkbook.Worksheets("Current_Week")
    
    lastRow = wsCurrentWeek.Range("E" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        If IsEmpty(wsCurrentWeek.Range("Q" & i)) Then
            stVal = Application.VLookup(wsCurrentWeek.Range("E" & i).Value, sh.Range("E:T"), 13, False)
            If Not IsError(stVal) Then wsCurrentWeek.Range("Q" & i) = stVal
        End If
        
        If IsEmpty(wsCurrentWeek.Range("R" & i)) Then
            stVal = Application.VLookup(wsCurrentWeek.Range("E" & i).Value, sh.Range("E:T"), 14, False)
            If Not IsError(stVal) Then wsCurrentWeek.Range("R" & i) = stVal
        End If
        
        If IsEmpty(wsCurrentWeek.Range("S" & i)) Then
            stVal = Application.VLookup(wsCurrentWeek.Range("E" & i).Value, sh.Range("E:T"), 15, False)
            If Not IsError(stVal) Then wsCurrentWeek.Range("S" & i) = stVal
        End If
        
        If IsEmpty(wsCurrentWeek.Range("T" & i)) Then
            stVal = Application.VLookup(wsCurrentWeek.Range("E" & i).Value, sh.Range("E:T"), 16, False)
            If Not IsError(stVal) Then wsCurrentWeek.Range("T" & i) = stVal
        End If
        Err.Clear
    Next


End Sub

I have kept your VLookUp44 code largely the same so you can make any adjustments if needed.


Hope helpful

Dave

 

[gallen]

@gallen I was having some trouble with your code, it still doesn't run. Where exactly do I put the second part of the code? Maybe that has something to do with it.

The 2nd part just goes underneath the 1st part. As long as it is in the same section as the original sub it will work.

If you are having trouble, let me know at what line the code stops. I've tested it here and it works up to this point:

If IsEmpty(Range("Q" & i)) Then
    
        '**************************************************ENTER RESULT INTO CELL THEN USE RESULT****************************************
    
        s = "=VLOOKUP(""" & Range("E" & i).Value & """,'" & sPath & "[" & sfileName & "]" & "Lookup_Sheet'!" & "E:T, 13, FALSE)"
        Range("_Result").Formula = s
        stVal = IIf(IsError(Range("_Result").Value), "Not Found", Range("_Result").Value)
        
        '********************************************************************************************************************************
        'Old line commented out stVal = Application.WorksheetFunction.VLookup(Range("E" & i).Value, Sheets("Lookup_Sheet").Range("E:T"), 13, False)
        On Error Resume Next
        Range("Q" & i) = stVal
    End If

So if range Q&i is empty this will execute and get the info from a closed workbook

 

[tinydancer]

So far neither of these have worked. @gallen when I run yours it goes up until I select the file, once I double click the excel sheet I want to use as the vlookup page it gives me the error, "Method 'Range' of object '_Global' failed".