Compare two cilumns

QuestionEdit

I have the Code which compare two columns(sheet1 ColumnA and Sheet2 Column A)values, resluting in next column things in A not in B and in another column things in B not in A in another column,for example i have "A" value in first cell of sheet1 of column A will search in sheet2 of columnA if it finds it writtens not it will go for next check,senow i am comparing with single column only, i wanted to compare entire file whichmeant sheet1 columnA Vs Sheet2 ColmnA Sheet1 ColumnB Vs Sheet2 ColumnB sheet1 columnC Vs Sheet2 ColumnC of the file and result in another sheet. Code in VBA -Sub Test() Dim ListA As range Dim ListB As range Dim c As range Set ListA = range("A2:A50000") Set ListB = Worksheets("final").range("A2:A50000") range("C1").Value = "Values in Seed(A) that are NOT in Final(A)" range("D1").Value = "Values in Final(A) that are Not in Seed(A)" range("E1").Value = "Count of Seed(A)" range("F1").Value = "Count of Final(A)" For Each c In ListA If c.Value <> "" Then range("E2").Value = range("E2").Value + 1 If Application.CountIf(ListB, c) = 0 Then Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C").Value = c End If End If Next c For Each c In ListB If c.Value <> "" Then range("F2").Value = range("F2").Value + 1 If Application.CountIf(ListA, c) = 0 Then Cells(Cells(Rows.Count, "D").End(xlUp).Row + 1, "D").Value = c End If End If Next c End Sub

Previously you have provided on solution but it was comparing entire content but this time column to column.Please help

AnswerEdit

This seems to work, using quite a different approach:

Sub DetermineOmissions()

   'Lists all cells which have no match in the same column:
   'So shows all values available in Sheet1, but not in 2 for cols a,b,c,d,...
   'and vice versa.
   Dim lCt As Long
   Dim lCols As Long
   On Error Resume Next
   If Worksheets("Sheet1").UsedRange.SpecialCells(xlCellTypeFormulas) Is Nothing Then
       'If there are no formulas, this is the next line to run, which places count formulas on both sheets
       PlaceFormulas
   End If
   On Error GoTo 0
   lCols = Worksheets("Sheet1").UsedRange.Columns.Count / 2
   For lCt = 1 To lCols
       With Worksheets("Sheet1")
           On Error Resume Next
           .AutoFilterMode = False
           .UsedRange.AutoFilter lCt + lCols, 0
           .UsedRange.Columns(lCt).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet3").Cells(1, 1 + (lCt - 1) * 2)
           Worksheets("Sheet3").Cells(1, 1 + (lCt - 1) * 2).Value = "Column " & lCt & "; In sheet1, Not in 2"
           .AutoFilterMode = False
       End With
       With Worksheets("Sheet2")
           On Error Resume Next
           .AutoFilterMode = False
           .UsedRange.AutoFilter lCt + lCols, 0
           .UsedRange.Columns(lCt).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet3").Cells(1, 2 + (lCt - 1) * 2)
           Worksheets("Sheet3").Cells(1, 2 + (lCt - 1) * 2).Value = "Column " & lCt & "; In sheet2, Not in 1"
           .AutoFilterMode = False
       End With
   Next

End Sub Sub PlaceFormulas()

   Dim lCols As Long
   With Worksheets("Sheet1")
       lCols = .UsedRange.Columns.Count
       .UsedRange.Offset(1, lCols).Resize(.UsedRange.Rows.Count - 1).FormulaR1C1 = _
       "=COUNTIF(Sheet2!R2C[-" & lCols & "]:R" & Worksheets("Sheet2").UsedRange.Rows.Count & "C[-" & lCols & "],RC[-" & lCols & "])"
   End With
   With Worksheets("Sheet2")
       .UsedRange.Offset(1, lCols).Resize(.UsedRange.Rows.Count - 1).FormulaR1C1 = _
       "=COUNTIF(Sheet1!R2C[-" & lCols & "]:R" & Worksheets("Sheet1").UsedRange.Rows.Count & "C[-" & lCols & "],RC[-" & lCols & "])"
   End With

End Sub