Cross Referencing a sheet to a master data sheet

Question

I have this macro that allows you to cross reference "Sheet2" in "Sheet1" where"Sheet1" is the sheet that will contain my master data. The idea here is to compare sheet 2 to the master data and see if it matches. The problem with this macro is that it only compares within a limited amount of range. I was wondering how to make this more dynamic or flexible should I add another column that would also be used for cross reference.

Here is the sample of my sheets.

 Example:

 Sheet1

 Name                 ID            Class Name         Taken?
 John Riley           0001          Painting           Yes
 Bob Johnson          0101          Painting           No
 Matthew Ward         1111          Math               Yes


 Sheet 2:

 Name                 ID            Class Name         Taken?
 Matthew Ward         1111          Math               Yes
 Bob Johnson          0101          Painting           No
 Warren Renner        2222          Drama              No
 John Riley           0001          Painting           Yes

What do I need to change in the macro to make it compare should I add additional columns in my sheets?

 Example:

 Sheet1

 Name                 ID            Class Name         Taken?    Date Taken
 John Riley           0001          Painting           Yes       8/25/13
 Bob Johnson          0101          Painting           No
 Matthew Ward         1111          Math               Yes       9/20/10


 Sheet 2:

 Name                 ID            Class Name         Taken?     Date Taken
 Matthew Ward         1111          Math               Yes        9/20/10
 Bob Johnson          0101          Painting           No         -
 Warren Renner        2222          Drama              No         -
 John Riley           0001          Painting           Yes        8/25/13

Code:

 Sub Compare_Data() 

Dim rngData2 As Range
Dim rngData1 As Range
Dim cell2    As Range
Dim cell1    As Range
Dim rLastCell    As Range


Set rngData2 = Worksheets("Sheet2").Range("B3", Worksheets("Sheet2").Range("B65536").End(xlUp))
Set rngData1 = Worksheets("Sheet1").Range("B3", Worksheets("Sheet1").Range("B65536").End(xlUp))


 '   Check customers in "Sheet2" to "Sheet1"
For Each cell2 In rngData2
    For Each cell1 In rngData1
        With cell1

            If .Offset(0, 0) = cell2.Offset(0, 0) And _ 
            .Offset(0, 1) = cell2.Offset(0, 1) And _ 
            .Offset(0, 2) = cell2.Offset(0, 2) And _ 
            .Offset(0, 3) = cell2.Offset(0, 3) Then 
                .Offset(0, -1).Range("A1:F1").Interior.ColorIndex = 3 
                cell2.Offset(0, 4) = .Offset(0, 4) 
            End If 



        End With
    Next cell1
Next cell2

End Sub

Your question is not quite clear. Also, your macro is quite insane to say the least. It must take hours to loop through 65533*65533 cells. — ApplePie
see stackoverflow.com/questions/11169445/… for the best way to find last row / column — Jzz
I'm still working on how to get the last row and last column with values for this macros. I'm more concerned on how will I make the comparing of sheets more dynamic. This macro looks into the first 4 columns of the Sheets only, but how do I make it compare all the columns if I wish to add more? "Sheet1" and "Sheet2" has the same amount of columns and is also in the same format. Let's say I add a new column "Year Level", how do I make this macro include that column as part of its reference, @AlexandreP.Levasseur? — user3675433

JohnGreen JohnGreen · Accepted Answer · 2014-05-31T10:59:25

Here is one way to make the macro accept any number of columns and increase the compare efficiency. Assuming that Sheet 1 is always sorted by ID, the first thing I would do is SORT Sheet2 by ID. This and changing the compare code will speed up the compare process. NOTE: if you have the same ID # with multiple ClassNames you need to sort Sheets 1 & 2 by Col B and C for the compare process to work. Second thing is change the compare code, as it is the code compares every row on sheet1 to every row on sheet2 for all the rows in the sheets, whether they contain data or not, horribly, horribly inefficient.

Sub Compare_Data()
Dim FirstRow As Long, FirstCol As Long, LastRow As Long, LastCol As Long
Dim SortSheet2 As Range
Dim S1LastRow As Double, S2LastRow As Double
ActiveWorkbook.Worksheets("Sheet2").Select ' find used range, name it, sort it
FirstRow = Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByRows).Row
FirstCol = Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByColumns).Column
LastRow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LastCol = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set SortSheet2 = Range(Cells(FirstRow, FirstCol), Cells(LastRow, LastCol))
SortSheet2.Select
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range(Cells(1, "B"), Cells(LastRow, "B")), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
    .SetRange Range("SortSheet2")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Range("A1").Select
Dim S1ID As Variant, S2ID As Variant, S1RowCntr As Long, S2RowCntr As Long, ColCnt As Long
S1RowCntr = 1
S2RowCntr = 1
ColCnt = 3 ' starting at Col C for the compare function
Application.ScreenUpdating = False 'set to True for troubleshooting
ActiveWorkbook.Worksheets("Sheet1").Select
Do Until IsEmpty(ActiveCell) ' loop thru Sheet 1 ID numbers
    S1RowCntr = S1RowCntr + 1
    Range(Cells(S1RowCntr, ColCnt - 1), Cells(S1RowCntr, ColCnt - 1)).Select
    S1Data = ActiveCell.Address
    S1ID = Range(S1Data).Value
    ActiveWorkbook.Worksheets("Sheet2").Activate
    S2RowCntr = S2RowCntr + 1
    Range(Cells(S2RowCntr, "B"), Cells(S2RowCntr, "B")).Activate
    S2Data = ActiveCell.Address
    S2ID = Range(S2Data).Value
    If S2ID = S1ID Then
        '
        Done = Equals(ColCnt, S1RowCntr, S2RowCntr, LastCol)
    Else
        Do Until S1ID = S2ID Or S2ID = ""
            S2RowCntr = S2RowCntr + 1
            Range(Cells(S2RowCntr, "B"), Cells(S2RowCntr, "B")).Select
            S2Data = ActiveCell.Address
            S2ID = Range(S2Data).Value
        Loop
        If S2ID = "" Then
            'Do nothing
        ElseIf S1ID = S2ID Then
            Done = Equals(ColCnt, S1RowCntr, S2RowCntr, LastCol)
        End If
    End If
    ColCnt = 3
    ActiveWorkbook.Worksheets("Sheet1").Select
Loop
ActiveWorkbook.Worksheets("Sheet1").Select
Range("A1").Select
End Sub
Function Equals(ByVal ColCnt As Long, ByVal S1RowCntr As Long, ByVal S2RowCntr As Long, ByVal LastCol As Long)
Same = True 'if the values are the same continue to compare all the columns
            '  if any value is false, stop and highlight, again efficient
Do Until ColCnt > LastCol Or Same = False
    ActiveWorkbook.Worksheets("Sheet1").Select
    Range(Cells(S1RowCntr, ColCnt), Cells(S1RowCntr, ColCnt)).Select
    S1Data = ActiveCell.Address
    Class = Range(S1Data).Value
    ActiveWorkbook.Worksheets("Sheet2").Select
    Range(Cells(S2RowCntr, ColCnt), Cells(S2RowCntr, ColCnt)).Select
    S2Data = ActiveCell.Address
    Taken = Range(S2Data).Value
    If Taken = Class Then
        Same = True
    Else
        ActiveWorkbook.Worksheets("Sheet1").Select
        Range(Cells(S1RowCntr, "A"), Cells(S1RowCntr, LastCol)).Select
        With Selection
            .Interior.ColorIndex = 3
        End With
        Same = False
    End If
    ColCnt = ColCnt + 1
Loop
End Function

Cross Referencing a sheet to a master data sheet

1 Answers