Compare Two Columns on Two Different Sheets and Paste the Results into a 3rd Sheet

Heyas,

I want to compare two different columns (A,C) on two different sheets (Sheet1, Sheet2) in the same workbook.  If a column value in 'Sheet2' doesn't have corresponding column value in 'Sheet1' the corresponding row of mismatch value is copied to Sheet3, if that makes sense.

Any help would be appreciated as I am complete VBA noob.

Thank you.
ZackGeneral IT Goto GuyAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

[ fanpages ]IT Services ConsultantCommented:
Hi,

...If a column value in 'Sheet2' doesn't have corresponding column value in 'Sheet1' the corresponding row of mismatch value is copied to Sheet3, if that makes sense.

No, sorry, not really.

I presume you wished to show all the rows from the [Sheet2] worksheet where the respective value in Column [C] is not within column [A] of the [Sheet1] worksheet.

In my example workbook, as attached, [Sheet1] does not have entries for "Item D" & "Item I", so these two rows are shown in [Sheet3] when it is selected.

However, [Sheet1] does have three additional rows (for "Item K", "Item L", & "Item M").  None of these rows are shown in [Sheet3].

Here is the Visual Basic for Applications code taken from the [Sheet3] code module within the attached workbook:

Option Explicit
Private Sub Worksheet_Activate()

' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28242532.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28242532
' Question Title:   Compare Two Columns on Two Different Sheets and Paste the Results into a 3rd Sheet
' Question Asker:   hellworld12345                            [ http://www.experts-exchange.com/M_6182444.html ]
' Question Dated:   2013-09-18 at 05:33:13
'
' Expert Comment:   fanpages                                   [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2013 Clearlogic Concepts (UK) Limited                           [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------------------------

  Dim blnApplication_ScreenUpdating                     As Boolean
  Dim lngErr_Number                                     As Long
  Dim objADODB_Connection                               As Object
  Dim objADODB_Recordset                                As Object
  Dim strSQL                                            As String
  Dim strErr_Description                                As String
 
  On Error GoTo Err_Workbook_SheetActivate
 
  blnApplication_ScreenUpdating = Application.ScreenUpdating
  Application.ScreenUpdating = False
  
  strSQL = ""
  strSQL = strSQL & "SELECT "
  strSQL = strSQL & "[S2].[Column_A],"
  strSQL = strSQL & "[S2].[Column_B],"
  strSQL = strSQL & "[S2].[Column_C],"
  strSQL = strSQL & "[S2].[Column_D] "
  
  strSQL = strSQL & "FROM "
  strSQL = strSQL & "[EXCEL " & _
                     IIf(Val(Application.Version) <= 11#, "8", "12") & ".0;"                                                                            ' Note: Val(...) only recognizes a period ["."] as a valid decimal separator
  strSQL = strSQL & "IMEX=1;"
  strSQL = strSQL & "HDR=Yes;"
  strSQL = strSQL & "DATABASE=" & ActiveWorkbook.FullName & "].[Sheet2$] As [S2] "
 
  strSQL = strSQL & "LEFT JOIN "
  strSQL = strSQL & "[EXCEL " & _
                     IIf(Val(Application.Version) <= 11#, "8", "12") & ".0;"                                                                            ' Note: Val(...) only recognizes a period ["."] as a valid decimal separator
  strSQL = strSQL & "IMEX=1;"
  strSQL = strSQL & "HDR=Yes;"
  strSQL = strSQL & "DATABASE=" & ActiveWorkbook.FullName & "].[Sheet1$] As [S1] "
  strSQL = strSQL & "ON "
  strSQL = strSQL & "[S2].[Column_C]=[S1].[Column_A] "
  
  strSQL = strSQL & "WHERE "
  strSQL = strSQL & "IsNull([S1].[Column_A])"
  
  Set objADODB_Connection = CreateObject("ADODB.Connection")
 
  objADODB_Connection.Provider = "Microsoft." & IIf(Val(Application.Version) <= 11#, "Jet.OLEDB.4.0", "ACE.OLEDB.12.0")
  objADODB_Connection.ConnectionString = "Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=Excel " & _
                                          IIf(Val(Application.Version) <= 11#, "8", "12") & ".0;"
  
  objADODB_Connection.Open
  
  Set objADODB_Recordset = CreateObject("ADODB.Recordset")
 
  objADODB_Recordset.CursorType = 3                          ' adOpenStatic
  objADODB_Recordset.CursorLocation = 3                      ' adUseClient
  objADODB_Recordset.ActiveConnection = objADODB_Connection
  
  objADODB_Recordset.Open (strSQL)
 
  Cells.ClearContents
  Worksheets("Sheet2").Rows(1&).Copy Worksheets("Sheet3").Rows(1&)
  [A2].CopyFromRecordset objADODB_Recordset
 
Exit_Workbook_SheetActivate:

  On Error Resume Next
 
  [A2].Select
 
  If Not (objADODB_Recordset Is Nothing) Then
     objADODB_Recordset.Close
     Set objADODB_Recordset = Nothing
  End If
 
  If Not (objADODB_Connection Is Nothing) Then
     objADODB_Connection.Close
     Set objADODB_Connection = Nothing
  End If

  Application.ScreenUpdating = blnApplication_ScreenUpdating
  
  Exit Sub
 
Err_Workbook_SheetActivate:

  lngErr_Number = Err.Number
  strErr_Description = Err.Description
  
  On Error Resume Next
  
  Application.ScreenUpdating = True
  
  Beep
  
  MsgBox "Error #" & CStr(lngErr_Number) & _
          vbCrLf & vbLf & _
          strErr_Description, _
          vbExclamation Or vbOKOnly, _
          ActiveWorkbook.Name
         
  Resume Exit_Workbook_SheetActivate
 
End Sub

Open in new window



Please download/save this workbook locally (instead of simply opening the file from your web browser's cache).

If you wish to make changes to the contents of either (or both) of the [Sheet1] &/or [Sheet2] worksheets, please do so.

Selecting (activating) the [Sheet3] worksheet will update the content of this worksheet accordingly.

PS. It should not be necessary to save the workbook before viewing the [Sheet3] worksheet, but if you find the result is not correct, I would recommend saving the workbook in advance of doing this.

BFN,

fp.

[EDIT: 25/09/2013 20:55 (UK time) - Corrected comments referring to a different thread]
Q-28242532.xls
0
ZackGeneral IT Goto GuyAuthor Commented:
Thank you very much for the code. Although is asking a bit could you explain to me what is going on in the as I absolutely no idea, i have never seen this type of VBA code before.
0
Harry LeeCommented:
hellworld12345,

So is both Sheet1 and Sheet2 has the Column A and Column C identical to each other?

If yes, which of the following scenario do you want?

A) Copy the row from Sheet2 to Sheet3 if either [Sheet2].ColumnA value is not in
     [Sheet1].ColumnA OR [Sheet2].ColumnC value is not in [Sheet1].ColumnC

B) Copy the row from Sheet2 to Sheet3 if both [Sheet2].ColumnA value is not in
     [Sheet1].ColumnA AND [Sheet2].ColumnC value is not in [Sheet1].ColumnC

C) Copy the row from Sheet2 to Sheet3 if [Sheet2].ColumnA value is not in either
     [Sheet1].ColumnA and [Sheet1].ColumnC OR [Sheet2].ColumnC Value is not in either
     [Sheet1].ColumnA and [Sheet1].ColumnC

Please be more specific. Not matter which scenario it is, the VBA is not going to be so complicated like what fanpages had provided. fanpages code is working in database, which is completely overkill for your situation.

Not that it doesn't work. In fact, it works very efficiently. It's just complicated.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

[ fanpages ]IT Services ConsultantCommented:
:) It is only complicated until you appreciate what it does.

To be fair, a majority of the code is error handling, & a "clean" release of resources used.

Thank you very much for the code. Although is asking a bit could you explain to me what is going on in the as I absolutely no idea, i have never seen this type of VBA code before.

You are very welcome.  I don't mind explaining it.  Do you have specific lack of knowledge with any specific lines, or just the whole approach?

Also, do you wish to pursue HarryHYLee's proposal(s) first, & come back to my solution later?

I presume you did try my workbook, & make sufficient changes to demonstrate the flexibility with the values of the four columns available in each of the first two worksheets as well as the speed of execution.
0
ZackGeneral IT Goto GuyAuthor Commented:
Hi HarryHYLee,

To clarify I want compare Column C on Sheet2 to Column A on Sheet 1. with the purpose of finding any values on Column C on Sheet 2 that Column A on Sheet 1 doesn't have.  Then any values that don't appear Column A on Sheet 1, I want to copy the corresponding row from Column C on Sheet 2 to Sheet 3.

Thank you.
0
[ fanpages ]IT Services ConsultantCommented:
Hi again,

Please find a new workbook attached to demonstrate an alternate approach to the one I posted initially (above).

I have added comments to this code (within the "basQ_28242532" code module) so you are aware what each discrete section is doing:

Option Explicit
Public Sub Q_28242532()

' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28242532.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28242532
' Question Title:   Compare Two Columns on Two Different Sheets and Paste the Results into a 3rd Sheet
' Question Asker:   hellworld12345                            [ http://www.experts-exchange.com/M_6182444.html ]
' Question Dated:   2013-09-18 at 05:33:13
'
' Expert Comment:   fanpages                                   [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2013 Clearlogic Concepts (UK) Limited                           [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------------------------

  Dim blnApplication_ScreenUpdating                     As Boolean
  Dim lngErr_Number                                     As Long
  Dim lngRow                                            As Long
  Dim objCell                                           As Range
  Dim strErr_Description                                As String
  Dim vntArray                                          As Variant
  
' If an error occurs, jump to the dedicated error handling code...

  On Error GoTo Err_Q_28242532
 
' Store the current Application.ScreenUpdating setting & then disable any updating...

  blnApplication_ScreenUpdating = Application.ScreenUpdating
  Application.ScreenUpdating = False
  
' Clear the contents of [Sheet3] from cell [A2] onwards...

  Worksheets("Sheet3").Select
  Range([A2], Cells([A2].End(xlDown).Row, [A2].End(xlToRight).Column)).ClearContents
  
' Create an array of values within column [A] of [Sheet1]...

  Worksheets("Sheet1").Select
  vntArray = Range([A2], Cells(Rows.Count, 1).End(xlUp)).Value
    
' Autofilter column [C] of [Sheet2] from the array of values...

  Worksheets("Sheet2").Select
  ActiveSheet.AutoFilterMode = False
  
  Rows(1&).AutoFilter Field:=3, _
                      Criteria1:=Application.Transpose(vntArray), _
                      Operator:=xlFilterValues
                                             
' Loop through column [C] of [Sheet2] finding any row hidden (due to the autofilter), & copy this row to [Sheet3]...

  lngRow = 1&
  
  For Each objCell In Range([A2], Cells(Rows.Count, 1).End(xlUp))
  
      If objCell.RowHeight = 0! Then
         lngRow = lngRow + 1&
         ActiveSheet.Rows(objCell.Row).Copy Destination:=Worksheets("Sheet3").Rows(lngRow)
      End If ' If objCell.RowHeight = 0! Then
  
  Next objCell
         
' Reset the Autofilter (so the hidden rows are now visible)...

  ActiveSheet.AutoFilterMode = False
         
Exit_Q_28242532:

  On Error Resume Next
 
' Ensure any rows copied to [Sheet3] are also visible...

  Worksheets("Sheet3").Select
  ActiveSheet.Rows.AutoFit
  [A2].Select
 
' Reinstate the Application.ScreenUpdating setting...

  Application.ScreenUpdating = blnApplication_ScreenUpdating
  
  Exit Sub
 
Err_Q_28242532:

' Store the error number & description (as these will be reset when the On Error Resume Next statement is executed)...

  lngErr_Number = Err.Number
  strErr_Description = Err.Description
  
  On Error Resume Next
  
' Display a MessageBox with the error details...

  Application.ScreenUpdating = True
  
  Beep
  
  MsgBox "Error #" & CStr(lngErr_Number) & _
          vbCrLf & vbLf & _
          strErr_Description, _
          vbExclamation Or vbOKOnly, _
          ActiveWorkbook.Name
         
' Skip the main body of the code & exit gracefully...

  Resume Exit_Q_28242532
  
End Sub

Open in new window



To use this code, please open the attached workbook, then use the [ALT]+[F8] key combination to display the "Macro" dialog window.

Select "Q_28252532" as the "Macro name" & then click the [Run] button.

BFN,

fp.

[EDIT: 25/09/2013 21:00 (UK time) - Corrected comments referring to a different thread]
Q-28242532b.xls
0
Harry LeeCommented:
Doesn't this do the same job but much simpler code?

Sub comparesheets()

Dim DBws As Worksheet, DBmrng As Range, DBrw As Integer, DBclmn As Integer, Currws As Worksheet, Currrw As Integer, Tgrws As Worksheet, Tgrrw As Integer

Set DBws = Sheets("Sheet1")
Set Currws = Sheets("Sheet2")
Set Tgrws = Sheets("Sheet3")

DBrw = DBws.Cells(Rows.Count, 1).End(xlUp).Row
DBclmn = DBws.Cells(1, Columns.Count).End(xlToLeft).Column
Set DBmrng = DBws.Columns("A")

Tgrws.Cells.Delete shift:=xlUp

Tgrws.Rows(1).Value = Currws.Rows(1).Value
Tgrrw = Tgrws.Cells(Rows.Count, 1).End(xlUp).Row

For Currrw = 2 To Currws.Cells(Rows.Count, 1).End(xlUp).Row
    If Not IsError(Application.Match(Currws.Range("C" & Currrw), DBmrng, 0)) Then
Else:
    Tgrrw = Tgrrw + 1
    Tgrws.Rows(Tgrrw).Value = Currws.Rows(Currrw).Value
End If
Next
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
[ fanpages ]IT Services ConsultantCommented:
Doesn't this do the same job but much simpler code?

Neither of the listings I provided have "complicated" code but, I suppose, this description is subjective.  Does that mean that in the last two days you have struggled to understand either of my proposals?  Please ask for further explanation/clarification if you need it.

My two sets of code include error handling that, may make them appear (to you) to be more complex as your own suggestion does not.

Your own is, I agree, shorter, but maybe if I declared all the variables in one line, & removed all the additional steps included to make the execution quicker than mine look similar.

That said, your own code can be cut down a little more:

If Not IsError(Application.Match(Currws.Range("C" & Currrw), DBmrng, 0)) Then
Else:
    Tgrrw = Tgrrw + 1
    Tgrws.Rows(Tgrrw).Value = Currws.Rows(Currrw).Value
End If

For instance, could be re-written to:

If IsError(Application.Match(Currws.Range("C" & Currrw), DBmrng, 0)) Then
    Tgrrw = Tgrrw + 1
    Tgrws.Rows(Tgrrw).Value = Currws.Rows(Currrw).Value
End If

This aside, if there are thousands of rows of data to process, then looping from top to bottom sequentially is not going to be quick in execution.
0
Harry LeeCommented:
fanpages, I didn't struggle to understand your code nor to get this code ready. I was too busy with work and didn't have a chance to look into this.

As I said, there is nothing wrong with your codes. They are both running very efficiently. As hellworld12345, have problem getting the code ready to do the job, he's probably a beginner on VBA. Your code is far more difficult to understand then a simple code.

Please don't get offended. I personally like your code so much. As you say especially for a very large set of data.
0
[ fanpages ]IT Services ConsultantCommented:
I am not offended; just concerned that a subjective view of complexity influences the asker's decision to adopt a proposed solution.
0
ZackGeneral IT Goto GuyAuthor Commented:
Heyas,

Here's a solution I found on the net several days ago. It's my favorite of the proposal solutions.

Sub comparesheets()

Sheet3.Cells.Clear 'Clear contents of Sheet before proceeding.

Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
Set sh1 = Sheet1 'Edit sheet name
Set sh2 = Sheet2 'Edit sheet name
Set sh3 = Sheet3 'Edit sheet name
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row with data for both list sheets
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A2:A" & lr1) 'Establish the ranges on both sheets
Set rng2 = sh2.Range("D3:D" & lr2)
With sh3 'If header not there, put them in
    If .Range("A1") = "" And .Range("B1") = "" Then
        .Range("A1") = "Extras in List 1"
        .Range("B1") = "Extras in List 2"
    End If
End With
    For Each c In rng1 'Run a loop for each list ID mismatches and paste to sheet 3.
        If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
            sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
        End If
    Next
    For Each c In rng2
        If Application.CountIf(rng1, c.Value) = 0 Then
            sh3.Cells(Rows.Count, 2).End(xlUp)(2) = c.Value
        End If
    Next
   
End Sub

But the experts of this question have posed a rather interesting ontological question; What is nature of simple?
0
ZackGeneral IT Goto GuyAuthor Commented:
Thank for your help :)
0
kadr leynCommented:
The comparing can be done with Excel Vba Codes using Ado .The compare process can be made with Excel Vba Worksheet.Countif Function .

Two columns in different worksheets were compared in this template .Found different results as entire row were copied to second worksheet .

Dim stk, msb As Worksheet
    Set stk = Sheets("Page1")
    Set msb = Sheets("Page2")
    
    Application.ScreenUpdating = False
    sat = (msb.Range("A" & Rows.Count).End(xlUp).Row) + 1
    For i = 2 To stk.Range("A" & Rows.Count).End(xlUp).Row
        If WorksheetFunction.CountIf(msb.Range("A2:A" & msb.Range("A" & Rows.Count).End(xlUp).Row), stk.Cells(i, "A")) = 0 Then
            msb.Range("a" & sat).EntireRow.Value = stk.Range("a" & i).EntireRow.Value
            msb.Range("a" & sat).Interior.ColorIndex = 22
            sat = sat + 1
        End If
    Next
...

Open in new window


Template Can Be Downloaded Here
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.