Using the Range Find Statement Instead of VLookup
For the most advanced usage of the Range.Find method and speed comparisons to the VLookup command, Rich's new book provides both in-depth coverage and also a downloadable app that does speed comparisons and the pros and cons of using each search technique.
Power-Up Using Excel VBA Sorts and Searches
The program below starts at the top of a column and proceeds to find a match for each cell in the colummn until the last line of the column is processed. It searches a master table to locate matching values, and then takes action if a match is found. Sound like a VLookup? Yes it does.
The code below in Workbook1 (the Copy) opens a second workbook (Workbook 2, the Original). Then, each cell in Workbook1 in column A is used as a search argument to find a matching value in the entire Column A of Workbook2 (the Original). If a match is found, then the value in Column F of the matching row of Workbook2 is copied to Column F of Workbook1 in the row where the search value was initiated. Notice that the parameter LookAt:=xlWhole is used in the find statement. Without that parameter, it would find a substring within a regular string, which, in most cases, is not desirable. Omitting the parameter will allow searches of substrings within a string.Program Code
Option Explicit
' ************************************************
' Variables For File Open Dialogue Box
' ************************************************
Public strDialogueFileTitle As String
Public strFilt As String
Public intFilterIndex As Integer
Public strCancel As String
Public strWorkbookNameAndPath As String
Public strWorkbookName As String
Public strWorksheetName As String
Public Sub UpdateCopyOfWorkbook()
Dim strWorkbookNameAndPathDemoOnly As String
Dim wkbCopyOfWorkbook As Workbook
Dim wkbOriginalWorkbook As Workbook
Dim wksWorksheetOfCopy As Worksheet
Dim wksWorksheetOfOriginal As Worksheet
Dim lngFirstRowOfOriginal As Long
Dim lngFirstRowOfCopy As Long
Dim lngLastRowOfOriginal As Long
Dim lngLastRowOfCopy As Long
Dim c As Variant
Dim i As Long
Set wkbCopyOfWorkbook = ThisWorkbook
Set wksWorksheetOfCopy = wkbCopyOfWorkbook.Sheets(1)
lngFirstRowOfOriginal = 2
lngFirstRowOfCopy = 2
' ****************************************************************************
' Set Up Filters For Which Files Should Show In The Open File Dialog Box
' ****************************************************************************
strFilt = "Excel Files (*.xls),*.xls," & _
"Excel Files (*.xlsx),*.xlsx,"
' ****************************************************************************
' Set Up The Prompt In The Dialogue Box
' ****************************************************************************
intFilterIndex = 1
strDialogueFileTitle = "Select The Original Workbook"
' ****************************************************************************
' Present the Open File Dialogue To The User
' ****************************************************************************
Call OpenFileDialogue
' ****************************************************************************
' Notify The User If No File Was Successfully Opened
' ****************************************************************************
If strCancel = "Y" Then
MsgBox ("An Open Error Occurred Importing Your File Selection")
Exit Sub
End If
' ********************************************************
' Set Original Workbook and Worksheet Variables
' ********************************************************
Set wkbOriginalWorkbook = ActiveWorkbook
Set wksWorksheetOfOriginal = wkbOriginalWorkbook.Sheets(1)
' ********************************************************
' Find the Last Row Of the Copy
' ********************************************************
lngLastRowOfOriginal = wksWorksheetOfOriginal.Cells(Rows.Count, "A").End(xlUp).Row
lngLastRowOfCopy = wksWorksheetOfCopy.Cells(Rows.Count, "A").End(xlUp).Row
' ********************************************************
' Loop Through Each Value in Column A of the Copy and
' Find a Match to the Orignal in Column A. When a match
' Is Found, Then Copy Cell F in the matching Row of the
' Original to Cell F in the Copy
' ********************************************************
For i = lngFirstRowOfCopy To lngLastRowOfCopy
With wksWorksheetOfOriginal.Range(Cells(lngFirstRowOfOriginal, 1), Cells(lngLastRowOfOriginal, 1))
Set c = .Find(wksWorksheetOfCopy.Cells(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
wksWorksheetOfCopy.Cells(i, 6).Value = wksWorksheetOfOriginal.Cells(c.Row, 6).Value
End If
End With
Next i
End Sub
Sub OpenFileDialogue()
' ************************************************
' Display a File Open Dialogue Box For The User
' ************************************************
strCancel = "N"
strWorkbookNameAndPath = Application.GetOpenFilename _
(FileFilter:=strFilt, _
FilterIndex:=intFilterIndex, _
Title:=strDialogueFileTitle)
' ************************************************
' Exit If No File Selected
' ************************************************
If strWorkbookNameAndPath = "" Then
MsgBox ("No Filename Selected")
strCancel = "Y"
Exit Sub
ElseIf strWorkbookNameAndPath = "False" Then
MsgBox ("You Clicked The Cancel Button")
strCancel = "Y"
Exit Sub
End If
' ******************************************************
' Now That You Have The User Selected File Name, Open It
' ******************************************************
Workbooks.Open strWorkbookNameAndPath
End Sub