COMPARE TWO EXCEL SHEETS

Sub Compair_Names()

''' This code goes in the Main workbook''

Application.ScreenUpdating = False

Dim i As Long

Dim c As Variant

Dim ws As Worksheet

Set ws = Sheets("Sheet1") ''rename to the worksheet in the main file

Dim ws2 As Worksheet

Set ws2 = Worksheets("Sheet2") ''

Dim Nlrow As Long '' for new sheet

Dim Mlrow As Long ''used in main workbook

Dim Llrow As Long ''use in Namelist

''' activate Namelistanddata.xls ''

'' we wiil loop down Main workbook and get the Names this will set the range for the loop

Mlrow = ws.Range("B65536").End(xlUp).Row

'' we will then find the Name's in Namelistanddata workbook

'' we first loop down the Main List

For i = 2 To Mlrow '''this start in row 2 and will go down to last row

    ''' now we activate Namelistanddata workbook ''

    Workbooks("Namelistanddata").Activate

    ''' now we set the range for the find

    '' you may need to rename "Sheet1" in this part of the code to the actual wks name

    With Workbooks("Namelistanddata").Sheets("Sheet1").Range("D2:D" & Workbooks("Namelistanddata").Sheets("Sheet1").Range("D65536").End(xlUp).Row)

        '' now find the names

        Set c = .Find(ws.Cells(i, 2), lookat:=xlWhole)

        If c Is Nothing Then

            ''''' we found the name now copy data to another worksheet in main workbook

            Nlrow = ws2.Range("A65536").End(xlUp).Row + 1

             '' you may need to rename "Sheet1" in this part of the code to the actual wks name

            Workbooks("Namelistanddata").Sheets("Sheet1").Range("A" & c.Row & ":P" & c.Row).Copy Destination:=ws2.Range("A" & Nlrow)

            

        End If

    End With

Next i



End Sub

Life is a Race
Thanks & Regards
By
Sabari Mahesh P M

Sub PB1() 

    Dim cf As Range, s1 As Worksheet, s2 As Worksheet, p As Long 

    Dim firstfound As String 

    Dim q As Long 

    Set s1 = Worksheets("Sheet1") 

    Set s2 = Worksheets("PL1") 

    p = 1 

    Application.ScreenUpdating = False 

    Do While Not IsEmpty(s2.Cells(p, 1)) 

        Set cf = s1.Columns.Find(s2.Cells(p, 1), SearchOrder:=xlByRows) 

        If Not cf Is Nothing Then 

            q = 0 

            firstfound = cf.Address 

            Do 

                cf.Offset(0, 1) = s2.Cells(p, 2) 

                Set cf = s1.Columns.FindNext(cf) 

                cf.Offset(0, 2) = s2.Cells(p, 3) 

                Set cf = s1.Columns.FindNext(cf) 

                cf.Offset(0, 3) = s2.Cells(p, 4) 

                Set cf = s1.Columns.FindNext(cf) 

                cf.Offset(0, 4) = s2.Cells(p, 5) 

                Set cf = s1.Columns.FindNext(cf) 

                cf.Offset(0, 6) = s2.Cells(p, 6) 

                Set cf = s1.Columns.FindNext(cf) 

                q = q + 1 

            Loop While Not cf Is Nothing And cf.Address <> firstfound And q <> 3 

             

        End If 

        p = p + 1 

    Loop 

     

    Application.ScreenUpdating = True 

End Sub 

Life is a Race
Thanks & Regards
By
Sabari Mahesh P M