Compare Rows in Sheet 1 & Sheet2

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I need a bit of code please to compare rows in sheet1(columns B,C,D,E & G
only as column F is not consistant) against rows in sheet 2.

SHEET1
A B C D E F G
28 6/03/2006 24/03/2006 100.00% Holiday Fred Bloggs (Exists in
Sheet2))
29 20/02/2006 24/02/2006 100.00% Holiday Holiday John Smith (Exists in Sheet2)
30 24/02/2006 24/02/2006 100.00% Holiday Holiday Ian Brown (Does not exist
in Sheet2 as column G is different)


SHEET2
A B C D E F G
28 6/03/2006 24/03/2006 100.00% Holiday Holiday Fred Bloggs
29 20/02/2006 24/02/2006 100.00% Holiday Holiday John Smith
30 24/02/2006 24/02/2006 100.00% Holiday Holiday Ian Grey

If row exists in sheet2 i don't want to do anything BUT if row does not
exists i'd like to copy the row from sheet1 and paste it into the next
available row in Sheet2
Thanks
MHD143
 
Option Explicit

Sub ProcessData()
Dim rng1 As Range, rng2 As Range
Dim cell As Range, rw As Long
Dim cnt As Long, c As Range
Dim firstAddress As String
Dim i As Long
With Worksheets("Sheet1")
Set rng1 = .Range(.Cells(2, 7), _
.Cells(Rows.Count, 7).End(xlUp))
End With
With Worksheets("Sheet2")
Set rng2 = .Range(.Cells(2, 7), _
.Cells(Rows.Count, 7).End(xlUp))
End With
rw = rng2.Rows(rng2.Rows.Count).Row + 1
For Each cell In rng1
Set c = rng2.Find(cell, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
cnt = 0
For i = -2 To -6 Step -1
If cell.Offset(0, i) <> c.Offset(0, i) Then
Exit For
End If
cnt = cnt + 1
Next i
If cnt < 5 Then
cell.EntireRow.Copy _
Worksheets("sheet2").Cells(rw, 1)
rw = rw + 1
End If
Set c = rng2.FindNext(c)
Loop While c.Address <> firstAddress
Else
cell.EntireRow.Copy _
Worksheets("sheet2").Cells(rw, 1)
rw = rw + 1
End If
Next cell
End Sub
 
that first posting was flawed. Try this instead:

Option Explicit

Sub ProcessData()
Dim rng1 As Range, rng2 As Range
Dim cell As Range, rw As Long
Dim cnt As Long, c As Range
Dim firstAddress As String
Dim i As Long, bFound As Boolean
With Worksheets("Sheet1")
Set rng1 = .Range(.Cells(2, 7), _
.Cells(Rows.Count, 7).End(xlUp))
End With
With Worksheets("Sheet2")
Set rng2 = .Range(.Cells(2, 7), _
.Cells(Rows.Count, 7).End(xlUp))
End With
rw = rng2.Rows(rng2.Rows.Count).Row + 1
For Each cell In rng1
Set c = rng2.Find(cell, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
bFound = False
Do
cnt = 0
For i = -2 To -6 Step -1
If cell.Offset(0, i) <> c.Offset(0, i) Then
Exit For
End If
cnt = cnt + 1
Next i
If cnt = 5 Then
bFound = True
Exit Do
End If
Set c = rng2.FindNext(c)
Loop While c.Address <> firstAddress
If bFound = False Then
cell.EntireRow.Copy _
Worksheets("sheet2").Cells(rw, 1)
rw = rw + 1
End If
Else
cell.EntireRow.Copy _
Worksheets("sheet2").Cells(rw, 1)
rw = rw + 1
End If
Next cell
End Sub
 
Thanks Tom

Tom Ogilvy said:
that first posting was flawed. Try this instead:

Option Explicit

Sub ProcessData()
Dim rng1 As Range, rng2 As Range
Dim cell As Range, rw As Long
Dim cnt As Long, c As Range
Dim firstAddress As String
Dim i As Long, bFound As Boolean
With Worksheets("Sheet1")
Set rng1 = .Range(.Cells(2, 7), _
.Cells(Rows.Count, 7).End(xlUp))
End With
With Worksheets("Sheet2")
Set rng2 = .Range(.Cells(2, 7), _
.Cells(Rows.Count, 7).End(xlUp))
End With
rw = rng2.Rows(rng2.Rows.Count).Row + 1
For Each cell In rng1
Set c = rng2.Find(cell, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
bFound = False
Do
cnt = 0
For i = -2 To -6 Step -1
If cell.Offset(0, i) <> c.Offset(0, i) Then
Exit For
End If
cnt = cnt + 1
Next i
If cnt = 5 Then
bFound = True
Exit Do
End If
Set c = rng2.FindNext(c)
Loop While c.Address <> firstAddress
If bFound = False Then
cell.EntireRow.Copy _
Worksheets("sheet2").Cells(rw, 1)
rw = rw + 1
End If
Else
cell.EntireRow.Copy _
Worksheets("sheet2").Cells(rw, 1)
rw = rw + 1
End If
Next cell
End Sub
Click to expand...
 
Back
Top