Do not know even whare to start on this one!

[Michael Wise]

Hey all,
Well I do not even where to begin on this one.

Senerio:
I have 2 sheets within a workbook containing rows of data. I need t
match certain cells of one sheet with certain cells of the other shee
if they match I want it to copy the matching rows onto a third shee
(unnamed at this time) all on one row. The first sheet we cal
(equipment) has text in column A I want to match to column C i
sheet(reports) . As well as column H in sheet(equipment) has to matc
column H in sheet(reports). There are other columns I will need t
match but I figure if someone could head me in the right direction
might be able to piece together the rest.

Michae

 

[Tom Ogilvy]

Dim rng as Range, cell as rng
Dim rng1 as Range, cell1 as rng
Dim rng3 as Range, rw as Long
With Worksheets("Equipment")
set rng = .Range(.Cells(2,1),.Cells(rows.count,1).End(xlup))
End with
With Worksheets("Reports")
set rng1 = .Range(.Cells(2,3),.Cells(rows.count,3).End(xlup))
End With
rw = 0
set rng3 = Worksheets("Sheet3").Range("A1")

for each cell in rng
for each cell1 in rng1
if cell.Value = cell1.Value then
if cell.offset(0,7).Value = cell1.offset(0,5).value then
rw = rw + 1
cell.Resize(1,10).Copy destination:=rng3(rw)
cell1.resize(1,10).copy destiantion:=rng3(rw,11)
end if
end if
Next cell1
Next cell

 

[Tom Ogilvy]

cell1.resize(1,10).copy destiantion:=rng3(rw,11)

should be

cell1.offset(0,-2).resize(1,10).copy destination:=rng3(rw,11)

--
Regards,
Tom Ogilvy

Dim rng as Range, cell as rng
Dim rng1 as Range, cell1 as rng
Dim rng3 as Range, rw as Long
With Worksheets("Equipment")
set rng = .Range(.Cells(2,1),.Cells(rows.count,1).End(xlup))
End with
With Worksheets("Reports")
set rng1 = .Range(.Cells(2,3),.Cells(rows.count,3).End(xlup))
End With
rw = 0
set rng3 = Worksheets("Sheet3").Range("A1")

for each cell in rng
for each cell1 in rng1
if cell.Value = cell1.Value then
if cell.offset(0,7).Value = cell1.offset(0,5).value then
rw = rw + 1
cell.Resize(1,10).Copy destination:=rng3(rw)
cell1.resize(1,10).copy destiantion:=rng3(rw,11)
end if
end if
Next cell1
Next cell

 

[Michael Wise]

Tom,
Thank you for your help now I have another delima. I need to get it t
compare each line item in sheet ("Equipment") through all rows in th
sheet ("Reports") before moveing to the next line item i
("Equipment")and paste those items that match up. On sheet("Equipment"
there are approximately 6800 rows as sheet("reports") have 168 rows an
each item on sheet("equipment") has at least one line that matches wit
one line that matches criteria on sheet("reports"). My thoughts here
leaning towards a Do Until Loop between set rng and set rng1 but lac
of decent experince has me boogled.

Current Code below:
Sub Service_Compare()


Dim rng As Range
Dim cell As Range
Dim rng1 As Range
Dim cell1 As Range


Dim rng3 As Range
Dim rw As Long
With Worksheets("Equipment")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
With Worksheets("Reports")
Set rng1 = .Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp))
End With
rw = 0
Set rng3 = Worksheets("Test").Range("A2")


For Each cell In rng
For Each cell1 In rng1
If cell.Value = cell1.Value Then ' Or cell1.Value = "All" O
cell1.Value = "*" Then
If cell.Offset(0, 1).Value = cell1.Offset(0, 1).Value O
cell1.Offset(0, 1).Value = "All" Or cell1.Value = "*" Then 'Plan
added
If cell.Offset(0, 2).Value = cell1.Offset(0, 2).Value O
cell1.Offset(0, 2).Value = "All" Or cell1.Value = "*" Then 'Prod Uni
added
If cell.Offset(0, 3).Value = cell1.Offset(0, 3).Value O
cell1.Offset(0, 3).Value = "All" Or cell1.Value = "*" Then 'Proces
Unit added
If cell.Offset(0, 4).Value = cell1.Offset(0, 4).Value O
cell1.Offset(0, 4).Value = "All" Or cell1.Value = "*" Then 'Bloc
added
If cell.Offset(0, 7).Value = cell1.Offset(0, 5).Value O
cell1.Offset(0, 5).Value = "All" Or cell1.Value = "*" Then 'Service
rw = rw + 1
cell.Resize(1, 52).Copy Destination:=rng3(rw)
cell1.Offset(0, -2).Resize(1, 52).Copy Destination:=rng3(rw, 11)
End If

End If
End If
End If
End If
End If
Next cell1
Next cell
End Su

 

[Michael Wise]

Tom,
Never mind stupidity on my part. The code you provided works exactl
how it needs to. I failed to run some checks on my data and wound u
having spaces in some fields that altered the check criteria. Agai
thank you.
Michae