Compare cell by cell in sheets

[slashdot]

hi all..i had a query regarding comparing cells which contains text in col A in worksheet 1 and cells with text in col A in worksheet2...i want a vba code to run for,compare each cell by cell in worksheet 1 with the cells in worksheet2 and copy,paste the matched cells in a new sheet named "copied" data....

P.S. worksheet1 contains repetitive text in colA

attached a sample worksheet.

[royUK]

It would be much faster to use formulas

[slashdot]

hmmm.its ok but i want to learn vba.i could not loop each cell perfectly.so was looking for the same....pls help me..

[slashdot]

i think i need to use compstr in column A of worksheet 1 with column A of worksheet 2 cell by cell....

[gjlindn]

Could you update your example to include what you want the output ("Copied" worksheet) to look like?

[gjlindn]

Could you update your example to include what you want the output ("Copied" worksheet) to look like?

Sorry slashdot. I'm still waiting for the example of how you want the output to look. Your workbook doesn't have any vba code in it...you might get more support if it at least appeared you had first attempted coding this yourself as well. Just a suggestion. Thanks!

[slashdot]

i had created the COPIED worksheet to copy paste all the items that match with sheet 2....i had tried writing the code but could not find it in my uploaded sheet...i m not sure that my office proxy had deleted it or not.?

[slashdot]

hello sirs,,,kindly tell me how can i complete this query..

[slashdot]

more than 3days no solution.hope it is not that much impossible..

[slashdot]

Thanks ,,gjlindn for that great reply.sorry i forgot to upload the example...will upload the example with in few minutes...

[slashdot]

hmmm.after a great struggle and searching from many codes & examples in vba.i could make out my problem but could not finish it.not sure,i m bowled out in the last lines of code...

i m very new to coding & all the credits to the original coders from where i had copied the code..


attached the updated version of example with vba code.....

[tigertiger]

There is no any code-line in your attached file?

In the result sheets (copies), why there exists "south american" in cell A4 that is not match any record in Src sheet?

how many records is there in your database?
and The records in the column A in Sheet Mast are unique?

[slashdot]

Sorry dude,,i had attached the example with code.but again its getting deleted..i could not find the reason....

[slashdot]

mr.tiger there is no such word like"southamerican"as quoted by you in my example sheet.

to the number of records question:my worksheet contains not less than 4000 lines everyday.

[slashdot]

Here is the sample code i had copied and tried adjusting to my requirements.pls tell me what more to be added.

Private Sub comparcells()
    Dim fRow As Long
    
    Dim rng1 As Range
    Dim rng2 As Range
    
    Dim cel As Range
    Dim fOne As String
    Dim fTwo As String
    
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
     
    Set ws1 = Sheets("Src")
    Set ws2 = Sheets("mast")
     
      Worksheets.Add
            ActiveSheet.Name = "copies"
     
    With ws1
          Set rng1 = Range(.Cells(1, 1), .Cells(65536, 1).End(xlUp))
      
    End With
     
     
    With ws2
       'row 1 to last row of data Sheet src:ColA
        Set rng2 = Range(.Cells(1, 1), .Cells(65536, 1).End(xlUp))
        For Each cel In rng1
                     
            fOne = cel
                     
            fTwo = cel
            
             On Error Resume Next
             
             'Find Sheet src:ColA in Sheet 2
            fRow = .Cells.Find(What:=fOne, After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).row

If fOne = fTwo Then
 ActiveCell.EntireRow.Copy("copies").Paste
 End If
 Next cel
 End With
 
End Sub

[gjlindn]

Here you go!

Option Explicit
Option Compare Text

Sub CompareValues()
    Dim wsCopies    As Worksheet
    Dim rFirst      As Range
    Dim rSecond     As Range
    Dim rCell       As Range
    Dim rMatch      As Range
    Dim lCount      As Long
    Dim bScrUpd     As Boolean
    Dim bEvents     As Boolean
    Dim lCalc       As Long
    
    'Improve performance
    With Application
        bScrUpd = .ScreenUpdating
        bEvents = .EnableEvents
        lCalc = .Calculation
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    'Change A1:A19 to your range with duplicate values
    Set rFirst = Sheets("src").Range("A1:A19")
    
    'Change A1:A6 to your range with no duplicate values
    Set rSecond = Sheets("Mast").Range("A1:A6")
    
    'Set worksheet Copies = worksheet object wsCopies
    On Error Resume Next
        Set wsCopies = Sheets("Copies")
        wsCopies.Cells.Clear
        If Err.Number <> 0 Then
            Set wsCopies = Worksheets.Add(After:=Sheets(Sheets.Count))
            wsCopies.Name = "Copies"
        End If
    On Error GoTo 0
    
    'Find rSecond in rFirst and add to Copies worksheet
    For Each rCell In rSecond
        Set rMatch = rFirst.Find(rSecond, LookIn:=xlValues, LookAt:=xlWhole)
        If Not rMatch Is Nothing Then
            Set rCell = rCell.Resize(1, 2)
            wsCopies.Cells(lCount + 1, 1).Resize(1, _
                rCell.Columns.Count).Value = rCell.Value
            lCount = lCount + 1
        End If
    Next
    
    'Clean up
    Set rFirst = Nothing
    Set rSecond = Nothing
    Set rMatch = Nothing
    Set rCell = Nothing
    
    'Restore Application settings
    With Application
        .ScreenUpdating = bScrUpd
        .EnableEvents = bEvents
        .Calculation = lCalc
    End With
End Sub

Good luck!

[slashdot]

Thanks mate..that was a rocking one..

[gjlindn]

You're welcome If that's working for you, would you mind marking this thread as SOLVED? Also, if you wouldn't mind, it would help me out if you'd click the scales to the right of my post. Thanks and have a great day!

[tigertiger]

Try to a new approach,

see the attached file, and Plz confirms the code is appropriate for your case or not