VLOOKUP not working when using a file selected using GetOpenFilename

Robdiqulous

New Member
Joined
Sep 11, 2017
Messages
15
I am trying to get this code to work but having an issue. I have this code that works perfectly in one of my macros. When I run the whole thing it goes through and things end up how I want them. If I just run this sub by itself and not have it part of the main macro, it gets an error on the line with the first VLOOKUP. It is a 1004 error, saying object-defined or application-defined error. Why will this run when part of the rest of the code but not when it is ran by itself? It does not reference anything in the other part of the code?

Anyone have an idea? I feel like it has to do with something like what actual value of X is.

Code:
Private Sub Create_VLOOKUP_Using_Old_Kronos_Full_File()'
' Create_VLOOKUP_Using_Old_Kronos_Full_File Macro
'


'


    Dim iRet As Integer
    Dim strPrompt As String
    Dim strTitle As String
 
    ' Promt
    strPrompt = "Please select the last Kronos Full File before the dates of this HCM Report." & vbCrLf & _
        "This will be used to find the Old Position, Org Unit, and Old Cost Center." & vbCrLf & _
        "For example, if the date of this report is 7-28-17 thru 8-25-17, the closest Kronos Full File you would want to use is 7-27-17."
 
    ' Dialog's Title
    strTitle = "Last Kronos Full File for Old Positions"
 
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbOK, strTitle)


    Dim LR As Long
    Dim X As String
    Dim lNewBracketLocation As Long
    
    X = Application.GetOpenFilename( _
        FileFilter:="Excel Files (*.xls*),*.xls*", _
        Title:="Choose the Kronos Full File.", MultiSelect:=False)
        
    Dim wbk As Workbook
    Set wbk = Workbooks.Open(Filename:=X, ReadOnly:=True)


    Dim shtName As String
    shtName = wbk.Worksheets(1).name
    wbk.Close
        
    MsgBox "You selected " & X
    'Find the last instance in the string of the path separator "\"
    lNewBracketLocation = InStrRev(X, Application.PathSeparator)
    'Edit the string to suit the VLOOKUP formula - insert "["
    X = Left$(X, lNewBracketLocation) & "[" & Right$(X, Len(X) - lNewBracketLocation)
    


    
    LR = Range("E" & Rows.Count).End(xlUp).Row
    
    
    
    Range("T2").Formula = "=VLOOKUP($E2,'" & X & "]shtName'!$B$1:$AP$99999,15,0)"
    Range("T2").AutoFill Destination:=Range("T2:T" & Range("E" & Rows.Count).End(xlUp).Row)
    Range("T2:T" & Range("E" & Rows.Count).End(xlUp).Row).Select
    Range("U2").Formula = "=VLOOKUP($E2,'" & X & "]shtName'!$B$1:$AP$99999,41,0)"
    Range("U2").AutoFill Destination:=Range("U2:U" & Range("E" & Rows.Count).End(xlUp).Row)
    Range("U2:U" & Range("E" & Rows.Count).End(xlUp).Row).Select
    Range("V2").Formula = "=VLOOKUP($E2,'" & X & "]shtName'!$B$1:$AP$99999,18,0)"
    Range("V2").AutoFill Destination:=Range("V2:V" & Range("E" & Rows.Count).End(xlUp).Row)
    Range("V2:V" & Range("E" & Rows.Count).End(xlUp).Row).Select
    Cells.Select
    Cells.EntireColumn.AutoFit

So this is the code that runs perfectly when ran as part of the whole macro. I don't think that the variable shtName is actually working, but it works anyway because there is only one sheet in that workbook. I know i can make it " & shtName & " but that still doesn't make it work when ran by itself.

I appreciate any help! Thank you!
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
You appear to be missing a "[" bracket in your formula, which would be related to shtName, but without knowing your other macro's or workbook, unable to comment why you're experiencing the issue you are.

Instead of using VLOOKUPs, which increases formula and calculations as well as links in your spreadsheet, you could hardcode the values from the source workbook and then have the name of the workbook where data is sourced from on row 1 to the far right.
Try:
Code:
Private Sub New_LOOKUP()

    Dim x       As Long
    Dim y       As Long
    Dim i       As Long
    Dim col     As Long
    Dim msg     As String
    Dim wkb     As Workbook
    Dim arr()   As Variant
    Dim dic     As Object
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    msg = "Please select the last Kronos Full File before the dates of this HCM Report." & vbCrLf & _
        "This will be used to find the Old Position, Org Unit, and Old Cost Center." & vbCrLf & _
        "For example, if the date of this report is 7-28-17 thru 8-25-17, the closest Kronos Full File you would want to use is 7-27-17."


    MsgBox msg, vbOKOnly, "Last Kronos Full File For Old Positions"
    msg = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Select Kronos Full File", 0)
    
    Set wkb = Workbooks.Open(msg, , True)
    MsgBox "You Selected: " & msg, vbOKOnly, "File Selection Confirmation"
    
    With ActiveWorkbook
        With .Sheets(1)
            x = .Cells(.Rows.count, 1).End(xlUp).row
            y = .Cells(1, .Columns.count).End(xlToLeft).column
            arr = .Cells(1, 2).Resize(x, y - 1).Value
        End With
        .Close False
    End With
    
    For i = 1 To 3
        For x = LBound(arr, 1) To UBound(arr, 1)
            For y = LBound(arr, 2) To UBound(arr, 2)
                If i = 1 Then col = 15
                If i = 2 Then col = 41
                If i = 3 Then col = 18
                dic(i & "|" & arr(x, 1)) = arr(x, col)
            Next y
        Next x
    Next i
    
    Application.ScreenUpdating = False
    With ActiveSheet
        x = .Cells(.Rows.count, 5).End(xlUp).row
        For y = 1 To 3
            For i = 2 To x
                .Cells(i, y + 19).Value = dic(y & "|" & .Cells(i, 5).Value)
            Next i
        Next y
        .cells(1,20).resize(, 3).EntireColumn.Autofit
        .Cells(1, .Columns.count).End(xlToLeft).Offset(, 2).Value = "Data from: " & wkb.Name
    End With
    Application.ScreenUpdating = True
    
    Set wkb = Nothing
    Erase arr
    Set dic = Nothing
    
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,584
Messages
6,125,678
Members
449,248
Latest member
wayneho98

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top