COMPARE TWO EXCEL SHEETS

Posted by Jithincanil under VB.NET on 4/16/2012 | Points: 10 | Views : 4400 | Status : [Member] | Replies : 2
Hi All,
Please help me with HOW TO COMPARE TWO EXCEL SHEETS HAVING MULTIPLE TABS AND 5000 FIELDS?
the user will be uploadin one excel sheet and thru de code it will be referrencing the excel sheet which is in diff location

Thanks in Advance

Jithin




Responses

Posted by: Sabarimahesh on: 4/17/2012 [Member] Bronze | Points: 25

Up
0
Down
Try this


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

Jithincanil, if this helps please login to Mark As Answer. | Alert Moderator

Posted by: Sabarimahesh on: 4/17/2012 [Member] Bronze | Points: 25

Up
0
Down
Otherwise Try this

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

Jithincanil, if this helps please login to Mark As Answer. | Alert Moderator

Login to post response