Comparing two excelsheets for uncommon records based on common 'id' field(Column)

Question

I am comparing two excelsheets in the same workbook.

I want to check whether the records from sheet1 are exactly same as records in sheet2 based on common Question_id(Column A of both worksheets)

This question_id(column A) has values such as

1
1a
1a.1
1a.1a
1a.1b
1a.1c
2
2a
2a.1
2a.1a
2a.1b
2a.1c etc....

I want to compare the records based on this Question_id(Column A Value).

If Question_id is same and records(the remaining row) are not same then am coloring those records in red background(only specific cells and not the whole row)

For the same, I have following code.

Sub RunCompare()

    Call compareSheets("Sheet1", "Sheet2")

End Sub


Sub compareSheets(shtSheet1 As String, shtSheet2 As String)

Dim mycell As Range
Dim mydiffs As Integer

    Application.ScreenUpdating = false

    'Color Uncommon records in Red Background
    For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
        If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
            
            mycell.Interior.Color = vbRed
            mydiffs = mydiffs + 1
            
        End If
    Next

    'Display no. of differences
    MsgBox mydiffs & " differences found", vbInformation

    ActiveWorkbook.Sheets(shtSheet2).Select


    MsgBox "Data Scrubbed Successfully..." 
    Application.ScreenUpdating = True
End Sub

The above code runs fine when I have same sequence of Question_id (and therefore of records) in both the excelsheets.

Assume I have different sequence of Question_id (and therefore of records) in both the sheets.

Then how I can achieve this...?

Something Like using where clause in my code Where Sheet1.Question_id = Sheet2.Question_id

i.e. I'll pick up question_id and the full row from sheet1 and I will compare it against records in sheet2 based on matching Question_id(value of Column A) only.

Can someone tell where I can put the condition and what type of condition so that, even if both the excelsheets have random sequences of Question_id; I will be able to compare the records from sheet1 and sheet2.

EDIT: on 23rd March 2015

I have changed the code using find() method instead of loops as below: Still I havn't arrived at my solution. Here am trying to list Question_Ids of all non-matching rows from sheet2 in sheet3 - Column A.

Option Explicit

Sub test()

    Dim rng As Range, c As Range, cfind As Range, mycell As Range, cfindRow As Range
  
    On Error Resume Next

    Worksheets("Sheet3").Cells.Clear

    With Worksheets("Sheet2")
        Set rng = .Range(.Range("A2"), .Range("a2").End(xlDown))
        
        For Each c In rng
        With Worksheets("Sheet1")
            Set cfind = .Columns("A:A").Cells.Find _
            (what:=c.Value, lookat:=xlWhole)
            
             'Find method always returns Range; So the following line should be something If cfind is not Nothing OR cfind <> Nothing (Both the syntaxes are wrong. Suggest me the right syntax please.
            If cfind = 1 Then
            'Here please tell me how to reference a whole row based on Column A value
            'Here using cfind and again using mycell is something wrong as mycell variable again compares rows in sheet2 with rows in sheet1 which include Question_Id too.
            
            Set mycell = ActiveWorkbook.Worksheets("Sheet2").UsedRange.End(xlDown)
            'My both the excelsheets have values from columns A to AD. Still I want to make the code for all used Ranges of columns instead of only A to AD.
            Set cfindRow = Worksheets("Sheet1").Rows("A2:AD").Cells.Find _
            (what:=mycell.Value, lookat:=xlWhole)
            

            'Find method always returns Range; So the following line should be something If cfindRow is not Nothing OR cfindRow <> Nothing (Both the syntaxes are wrong. Suggest me the right syntax please.

            If cfindRow = 1 Then
            'MsgBox "Match Found"  'Right Now do Nothing
            End If
            Else
            
            ' mycell.Interior.Color = vbRed
            ' mydiffs = mydiffs + 1

           
            'Copy the question numbers to sheet3 either if they are new in new sheet (Sheet2) or content against them (in the whole row-any column value) is changed.
            cfind.Copy Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            
               
            End If
        End With 
        Next c
        Application.CutCopyMode = False
    End With 


   MsgBox "Data Scrubbed Successfully..." 
 End Sub

Can someone tell me how to refer those ranges based on key column values?

My new approach towards solution:

(It may be a hint to give me answer on how to reference Row values based on key column)

Getting row indices of both the sheets; column A values (Question_Id's) i.e.

c.Row and cfind.Row

Then

Check If(Sheet2.Cells(c.Row, Columns) = Sheet1.Cells(cfind.Row, Columns) (To compare columns against matching Question_Ids only.)

So Finally this what all am trying to achieve :

1)Compare two sheets based on key column:

Pick up the Question_Id from Sheet2 - column A and compare it against column A in Sheet1. If the key columns from both the sheets match and also the contents against them(the complete row) matches- then Do nothing.

If the key column value(Question_Id - Column A) matches but values(Row) against it do not match them color those specific cells (Only cells) and not the whole row in Red background.

2. The Question_Id's which are there in sheet2 but not in sheet1 should be listed under first column in sheet3. Starting from A2.

3. The Question_Id's which are there in sheet1 but not in sheet2 should be listed under second column in sheet3. Starting from B2.

Answer 1

I am basing my code off of your first approach, because I found it simpler and more readable than the second approach.

We'll just do the most naive algorithm, which is to iterate through every row in the used range of both worksheets. (The fastest algorithm would probably be to sort both ranges in memory and then compare, but simplicity of code over performance optimization for now.)

Sub compareSheets(shtSheet1 As String, shtSheet2 As String)
    Dim range1 As Range, range2 as Range
    Dim mydiffs As Integer, row1 As Integer, row2 As Integer, col As Integer
    Application.ScreenUpdating = False

    'First create the two ranges we will be using
    Set range1 = ActiveWorkbook.Worksheets(shtSheet1).UsedRange
    Set range2 = ActiveWorkbook.Worksheets(shtSheet2).UsedRange

    'Iterate through the rows of both ranges
    For row1 = 1 To range1.Rows.Count
        For row2 = 1 To range2.Rows.Count

            'Only process the ranges if they share a common key in column 1
            If range1.Cells(row1, 1) = range2.Cells(row2, 1) Then

                'If they share the same key, iterate through columns and compare
                For col = 1 To WorksheetFunction.Max(range1.Columns.Count, range2.Columns.Count)
                    If Not range1.Cells(row1, col).Value = range2.Cells(row2, col).Value Then
                        range1.Cells(row1, col).Interior.Color = vbRed
                        range2.Cells(row2, col).Interior.Color = vbRed
                        mydiffs = mydiffs + 1
                    End If
                Next

            End If

        Next
    Next

    'Display no. of differences
    MsgBox mydiffs & " differences found", vbInformation

    Application.ScreenUpdating = True
End Sub

There are some specifications I wasn't sure of. For example, what if a key is in one spreadsheet but not the other? Should it be colored red in the sheet where it exists?

Nevertheless, I think the above code should give you a good start to address your more conceptual questions, and I'm happy to help adjust as needed, so please comment if there are specific requirements I'm missing.

Update 1

Here's the update code after our discussion in chat (link in comments), which takes the unmatched keys from the full outer join and copies them to a third sheet.

Sub compareSheets(shtSheet1 As String, shtSheet2 As String, shtSheet3 As String)
    Application.ScreenUpdating = False

    Dim range1 As Range, range2 As Range
    Dim myDiffs As Integer, row1 As Integer, row2 As Integer, col As Integer
    Dim sheet3index1 As Integer, sheet3index2 As Integer, i As Integer

    Dim leftKeyMatched As Boolean 'Boolean to keep track of whether the key in sheet1 has a match as we are looping
    Dim rightKeysMatched() As Boolean 'Array to keep track of which keys in sheet2 have matches

    Set range1 = ActiveWorkbook.Worksheets(shtSheet1).UsedRange
    Set range2 = ActiveWorkbook.Worksheets(shtSheet2).UsedRange

    ReDim rightKeysMatched(range2.Rows.Count)

    For row1 = 1 To range1.Rows.Count
        leftKeyMatched = False
        For row2 = 1 To range2.Rows.Count

            If range1.Cells(row1, 1) = range2.Cells(row2, 1) Then
                'We have a match, so mark both sides as matched
                leftKeyMatched = True
                rightKeysMatched(row2 - 1) = True 'This -1 is because the array indexing starts at 0 but the rows in the spreadsheet start at 1

                For col = 1 To WorksheetFunction.Max(range1.Columns.Count, range2.Columns.Count)
                    If Not range1.Cells(row1, col).Value = range2.Cells(row2, col).Value Then
                        range1.Cells(row1, col).Interior.Color = vbRed
                        range2.Cells(row2, col).Interior.Color = vbRed
                        myDiffs = myDiffs + 1
                    End If
                Next
            End If
        Next

        'Print out the key from sheet1 if it didn't find a match in sheet2
        If leftKeyMatched = False Then
            sheet3index1 = sheet3index1 + 1
            ActiveWorkbook.Worksheets(shtSheet3).Cells(sheet3index1, 1) = range1.Cells(row1, 1)
        End If
    Next

    'Now print out any key that still hasn't been matched in sheet2
    For i = 0 To range2.Rows.Count
        If rightKeysMatched(i) = False Then
            sheet3index2 = sheet3index2 + 1
            ActiveWorkbook.Worksheets(shtSheet3).Cells(sheet3index2, 2) = range2.Cells(i + 1, 1) '+1 for same reason as above, index starts at 0 versus 1
        End If
    Next

    'Display no. of differences
    'MsgBox myDiffs & " differences found", vbInformation

    Application.ScreenUpdating = True
End Sub

Answer 2

I'll take a crack at this

Sub compareSheets(shtSheet1 As String, shtSheet2 As String)
Dim mycell As Range
Dim mydiffs As Integer
Dim ws1 as WorkSheet
Dim ws2 as WorkSheet
Dim rng as Range
Dim SourceRow as integer
Dim Col as integer

set ws1 = ActiveWorkbook.Worksheets(shtSheet1)
set ws2 = ActiveWorkbook.Worksheets(shtSheet2)
myDiffs = 0

'Application.ScreenUpdating = false  'enable this later, once it's all working

'Color Uncommon records in Red Background
'your key is in column A, so we'll only loop through that column
For sourceRow = 1 to ws2.usedrange.Rows.Count
  set rng = ws1.range(ws1.address).find(what:=ws2.cells(sourcerow, 1), LookIn:=xlValues, _
            LookAt=xlWhole, MatchCase:=False) 
            'making an assumption on MatchCase, change as needed
  if not rng is Nothing then  'we found the key, now let's look at the rest of the row
    col = 2
    'loop through the rest of the columns for this row
    while col < ws2.usedRange.Columns.Count
      'if the cell in the row we just found on sheet1 <> the cell that we were looking for from sheet2
      if rng.cells(1,col) <> ws2.cells(sourcerow,col) then
        rng.cells(1,col).Interior.Color = vbRed
        mydiffs = mydiffs+1
      end if
      col = col + 1
    wend
  else
    'we didn't find the key. pop up a msgbox. you may want something else
    MsgBox ("Sheet2 key: " & ws1.value & " not found on Sheet1")
  end if
'Display no. of differences
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(shtSheet2).Select
MsgBox "Data Scrubbed Successfully..." 
Application.ScreenUpdating = True
End Sub

Answer 3

If you want to find a value in a range use the following:

.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

Like this :

Application.ScreenUpdating = False
'On Error Resume Next    'Err.Numbers 9, 91 => Find: value not found 

Dim findCell as range
ActiveWorkbook.Worksheets(shtSheet2).Select
ActiveWorkbook.Worksheets(shtSheet2).UsedRange.Select
'Color Uncommon records in Red Background
For Each mycell In ActiveWorkbook.Worksheets(shtSheet1).UsedRange
    Set findCell = Selection.Find(What:=Trim(mycell.value & ""), LookIn:=xlValues)
    If findCell Is Nothing Then

        mycell.Interior.Color = vbRed
        mydiffs = mydiffs + 1

    End If
Next

Note :
Please change Application.ScreenUpdating = True to Application.ScreenUpdating = False

And for more information use this MSDN article

And for using a function like that you want:

Public Function look_up_id (r as Range) As Variant
'
'Function body
'
End Function

'....
Call look_up_id(ActiveWorkbook.Worksheets(shtSheet2).Range("A:A", table))
'....