Addendum : I've been asked what is the point of this script when excel offers the VLOOKUP function. The aim of this script is to scan lists that cannot be sorted for several reasons (e.g. chronological data).
Besides my activities as system administrator, I am also known (most probably wrongly) for my "über-skills" with Microsoft Excel. I am very often dealing with data reconciliation in huge excel lists and so on. Most of this involves post-analysis with Active Directory data.
Being a firm believer of the "if you can, script it" credo, I have done so and I present you with a modest creation: my "Correlate IDs" VBS Script.
Let's use a practical case : we have inherited two lists :
List1.xls has Employee IDs and Employee Names.
List2.xls has Employee IDs and their Line Manager Names only.
We want to show in one list both Employee ID, Employee Name and Line Manager Name. How do we proceed?
Let's add both lists in a single document with four colums :
A – Employee ID
B – Employee Name
E – Employee ID
F – Line Manager Name
You have gathered data in columns A and B from List1.xls, and data from columns E and F from List2.xls.
You want to fill column C with the Line Manager name. How do we proceed ?
We call our script, which presents us with 7 dialog boxes :
Dialog Box 1 : Specify the Excel Sheet name
Dialog Box 2 : Cell position to start searching for IDs (ex. A2)
Dialog Box 3 : Column where data will be written (we said above we want to use column C, therefore we input C)
Dialog Box 4 : We specify where do we scan for Target IDs (in our case, column E, as we compare employee IDs between columns A and E)
Dialog Box 5 : We specify here where is located the data that we will copy back in column C (in our case, column F)
Dialog Box 6 : We specify the number of rows to scan in column A
Dialog Box 7 : We specify the number of rows to scan in column E
After that, the script will execute and will autofill the data as you requested.
Magic, isn't it ?
Have good fun correlating your lists and enjoy a nice cup of coffee or tea!
Max
Code starts here :
Option Explicit
Sub CorrelateIDs() 'by Max - www.kamshin.com 'Scans for IDs in column LeftIDCol$, checks for a match in Column RightIDCol$ 'then fills the matching LeftDataCol$ cell with the value contained in RightDataCol$ cell Dim Tab1Cursor, Tab2Cursor, MaxRowsLeft, MaxRowsRight As Integer Dim CurrentLeftTblCursor$, CurrentLeftTblWriteCursor$ Dim CurrentRightTblCursor$, CurrentRightTblReadCursor$ Dim CurrentLeftTblID$, CurrentRightTblID$, CurrentRightTblWriteVal$ Dim Extr$, UserSelectedSheet$, WriteCol$, RightIDCol$, RightDataCol$, LeftIDCol$, LeftDataCol$ UserSelectedSheet$ = InputBox("Please enter Sheet name", "Sheet Name ?") Worksheets(UserSelectedSheet$).Activate CurrentLeftTblCursor$ = InputBox("Please enter first SOURCE IDs are located (ex. A2)", "Start Cell", "A2") LeftIDCol$=Left(CurrentLeftTblCursor$,1) Extr$ = Right(CurrentLeftTblCursor, 1) Tab1Cursor = CInt(Extr$) LeftDataCol$ = InputBox("Please enter column name where data will be written (ex. B)", "Start Cell", "B") RightIDCol$ = InputBox("Please enter column name where TARGET IDs are located (ex. C)", "Start Cell", "C") RightDataCol$ = InputBox("Please enter column name where TARGET DATA is located (ex. D)", "Start Cell", "D") MaxRowsLeft = CInt(InputBox("Please specify how many lines to check in the left table (ex. 300)", "Max Left Table lines", "300")) MaxRowsRight = CInt(InputBox("Please specify how many lines to check in the right table (ex. 300)", "Max Right Table lines", "300")) Do While Tab1Cursor < MaxRowsLeft CurrentLeftTblCursor$ = LeftIDCol$ & Tab1Cursor CurrentLeftTblWriteCursor$ = LeftDataCol$ & Tab1Cursor Tab1Cursor = Tab1Cursor + 1 Tab2Cursor = CInt(Extr$) Range(CurrentLeftTblCursor$).Select CurrentLeftTblID$ = ActiveCell.FormulaR1C1 Do While Tab2Cursor < MaxRowsRight CurrentRightTblCursor$ = RightIDCol$ & Tab2Cursor CurrentRightTblReadCursor$ = RightDataCol$ & Tab2Cursor Tab2Cursor = Tab2Cursor + 1 Range(CurrentRightTblCursor$).Select CurrentRightTblID$ = ActiveCell.FormulaR1C1 If CurrentRightTblID$ = CurrentLeftTblID$ Then Range(CurrentRightTblReadCursor$).Select CurrentRightTblWriteVal$ = ActiveCell.FormulaR1C1 Range(CurrentLeftTblWriteCursor$).Select ActiveCell.FormulaR1C1 = CurrentRightTblWriteVal$ Exit Do End If Loop Loop End Sub