Excel Help - Cross check columns

Microsoft Excel 2007 home and student
April 17, 2010 at 11:58:54
Specs: Windows 7

I have 3 sheets in Excel that each contain
data for a person's name and their
corresponding personal number. I would like to
cross check the sheets and add any
names/#'s appearing on all 3 sheets to a 4th
sheet. Can someone help me find the best
way to do this? It would be reaaally helpful!


See More: Excel Help - Cross check columns

Report •

April 17, 2010 at 13:15:57

This macro takes the data in column A in worksheets named "Sheet1", "Sheet2" and "Sheet3",
and tests if the data in column A exists in column A of worksheet "Sheet4"

If the data is not present, then the entire row from the source worksheet (Sheet1, Sheet2 or Sheet3) is copied to the next available row on Sheet4.

Finally the data on Sheet4 is sorted based on the data in column A.

You did not say where your data was held, so this macro is based on the following assumptions:
1. All data starts on Row 2 of the respective worksheets.
2. Column A contains data that can be compared, and can be used to identify the row of data uniquely, e.g., ID number, but it could be name if the data is unique - first and last names in same cell.

To run the macro, I suggest you add a button to your destination worksheet - "Sheet4"
From the Ribbon select Developer (If it's not visible go to the Office Button, select Excel options at the bottom and select the Popular tab and check the 'Show Developer tab in the Ribbon' box)

In Developer - Controls select Insert and choose the button icon.
Draw the button on the worksheet
In the 'Assign Macro' dialog box select 'New'

In the code window that opens enter this:

Option Explicit

Sub Button1_Click()
Dim rngStart As Range
Dim rngEnd As Range
Dim rngSrcCell As Range
Dim rngDestCell As Range
Dim rngDestStart As Range
Dim intDestOffst As Integer
Dim strShtNme As String
Dim blnExists As Boolean
Dim n As Integer

On Error GoTo ErrHnd

'turn screen updating off
Application.ScreenUpdating = False

'set start of destination data on Sheet4, column A
Set rngDestStart = Worksheets("Sheet4").Range("A2")
'set destination row offset counter
intDestOffst = 0

'loop through the three worksheets Sheet1, Sheet2 & Sheet3
For n = 1 To 3
    'create worksheet name
    strShtNme = "Sheet" & Format(n, "0")
    'set start of data - A2 on each sheet
    Set rngStart = Worksheets(strShtNme).Range("A2")
    'Find end of data in column A on each sheet
    Set rngEnd = Worksheets(strShtNme).Range("A" & CStr(Application.Rows.Count)) _
    'loop through all rows of data (column A)
    For Each rngSrcCell In Worksheets(strShtNme).Range(rngStart, rngEnd)
        'flag that it is not present in Sheet4
        blnExists = False
        'test if ID present in Sheet4
        For Each rngDestCell In rngDestStart.Resize(intDestOffst + 1, 1)
            If rngSrcCell.Value = rngDestCell.Value Then
                'flag that it exists
                blnExists = True
            End If
        Next rngDestCell
        'if it does not exist in Sheet4, copy it
        If blnExists = False Then
            rngDestStart.Offset(intDestOffst, 0).PasteSpecial _
            'increment destination offset
            intDestOffst = intDestOffst + 1
        End If
    Next rngSrcCell
Next n

'All copied, so now put data on Sheet4 in order
'sort on column A
'Sort says no header as the range selected starts on row 2
Worksheets("Sheet4").Range(rngDestStart.Row & ":" & _
        rngDestStart.Offset(intDestOffst, 0).Row).Sort _
        Key1:=Worksheets("Sheet4").Columns("A"), _
'turn screen updating on again
Application.ScreenUpdating = True
Exit Sub

'error handler
'turn screen updating on again
Application.ScreenUpdating = True
End Sub

Note that Sub Button1_Click() and End sub will already be present, so don't duplicate them. Option explicit goes before Sub Button1_Click().

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.

Right click the button and Edit the name to something meaningful

As Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

After selecting any cell, the new command button should now respond to a click and run the macro.

Note that the way that this macro finds the end of the data on sheets 1, 2 and 3 requires that all cells in column A below the data are empty.


Report •
Related Solutions

Ask Question