VBA - InputBox Vlookup

[thedm]

Hi ExcelExperts,

The below vba codes is working fine. But my boss wants the lookup_value, table_array, col_index_num should put in a inputbox as they added column, meaning dynamic range. match=false as default
She wants the other excel/workbook opened to be vlookup coz we're using another excel file. I really need your help.

Sub GetLastMoQOH_Click()
Dim goalsWbk As Workbook, dataWbk As Workbook
Dim goalsWs As Worksheet, dataWs As Worksheet
Dim goalsLastRow As Long, dataLastRow As Long, x As Long
Dim DataRng As Range
Dim FormatRuleInput As String

Set goalsWbk = ThisWorkbook
Set dataWbk = Workbooks.Open("C:\Users\Tesla\Documents\Inventory\LastMonthReport.xlsm")
Set goalsWs = ThisWorkbook.Worksheets("COUNT SHEET")
Set dataWs = dataWbk.Worksheets("Inventory Detail")

goalsLastRow = goalsWs.Range("J" & Rows.Count).End(xlUp).Row
'dataLastRow = dataWs.Range("B" & Rows.Count).End(xlUp).Row

'Set DataRng = dataWs.Range("B5:I" & dataLastRow)

'Get A Cell Address From The User to Get Number Format From
  On Error Resume Next
    Set DataRng = Application.InputBox( _
      Title:="Highlight Cells from Previous/Last Month ", _
      Prompt:="Select a cell range to highlight from the header ITEM to the bottom of QOH. Columns should be 8 to get the accurate results.", _
      Type:=8)
     
For x = 2 To goalsLastRow
    On Error Resume Next
    goalsWs.Range("R" & x).Value = Application.WorksheetFunction.VLookup( _
        goalsWs.Range("J" & x).Value, DataRng, 8, False)
        
Next x


  On Error GoTo 0

'Test to ensure User Did not cancel
  If DataRng Is Nothing Then Exit Sub
  
'Set Variable to first cell in user's input (ensuring only 1 cell)
  Set DataRng = DataRng.Cells(1, 1)

'Store Number Format Rule
  FormatRuleInput = DataRng.NumberFormat

'Apply NumberFormat To User Selection
  If TypeName(Selection) = "Range" Then
    Selection.NumberFormat = FormatRuleInput
  Else
    MsgBox "Please select a range of cells before running this macro!"
  End If

MsgBox "Done!"
goalsWbk.Activate
goalsWbk.Save
'goalsWbk.Close
'Resume Next
      


End Sub

 

[thedm]

Working Updates:

For now only the column range number is ask, for a dynamic vlookup value and array range. Still open for better suggestions or improve codings.
Aloha and Mahalo!

Sub Vlookup()

On Error GoTo Err_Error_Handler

Dim goalsWbk As Workbook, dataWbk As Workbook
Dim goalsWs As Worksheet, dataWs As Worksheet
Dim goalsLastRow As Long, dataLastRow As Long, x As Long
Dim DataRng As Range
Dim Fname As Variant

Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Open file to vlookup")
If Fname = False Then Exit Sub

Set goalsWbk = ThisWorkbook
Set dataWbk = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set goalsWs = ThisWorkbook.Worksheets("COUNT SHEET")
Set dataWs = dataWbk.Worksheets("Inventory Detail")

Dim LookupC As Integer

LookupC = Application.InputBox("Number of columns from the left?")

goalsLastRow = goalsWs.Range("J" & Rows.Count).End(xlUp).Row
dataLastRow = dataWs.Range("B" & Rows.Count).End(xlUp).Row

Set DataRng = dataWs.Range("B5:Z" & dataLastRow)

For x = 2 To goalsLastRow
    On Error Resume Next
    goalsWs.Range("R" & x).Value = Application.WorksheetFunction.Vlookup( _
        goalsWs.Range("J" & x).Value, DataRng, LookupC, False)
        
Next x

MsgBox ("Done and Save!" & vbNewLine & "Double check quantity if match." & vbNewLine & vbNewLine & "If you need any help, please email admin.")
goalsWbk.Save
goalsWbk.Activate

Exit_Error_Handler:
    Exit Sub
    
Err_Error_Handler:
    Application.Cursor = xlNormal
        'MsgBox "Cannot locate item. Make sure Worksheet name is Inventory Detail. " & Err.Number & " - " & Err.Description
        
        Dim strMsg As String
strMsg = "Error:" & vbNewLine & vbNewLine
strMsg = strMsg & "• Make sure to open the correct workbook with worksheet name 'Inventory Detail'" & vbNewLine
strMsg = strMsg & Chr(149) & " Re-run the vlookup button again." & vbNewLine
strMsg = strMsg & Chr(149) & " If you need help, please email admin."
'strMsg = strMsg & "• The dot is CHR(149)" & vbNewLine
'strMsg = strMsg & Chr(149) & " Item 3" & vbNewLine
'strMsg = strMsg & Chr(149) & " Item 4"

MsgBox strMsg, vbInformation

    Resume Exit_Error_Handler
    
End Sub
Sub ClearLastMoQOH_Click()

Range("R5", Range("R" & Rows.Count).End(xlDown)).ClearContents
    MsgBox "Cleared!"
Range("R5").Select
End Sub