June 2, 2010

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