MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Need help matching up lists using Dave Hawley ‘s Macro


Posted by John Piccolo on August 04, 2001 7:54 AM

Dave,

I am trying to use the Macro (Sub CopyDupes) you wrote for Claudette on May 9th, 01. to match up 2 sets of lists. My problem is that my 2 lists have 4 columns each instead of 2.

List 1 has: Item Number, Item Discription, Units TY, Dollars TY.
List 2 has: Item Number, Item Discription, Units LY, Dollars LY.

There is no way to sort them because not all of the items are in both lists. I need to do this monthly and it’s driving me crazy with approx 1500 items to match up.

Any help would be greatly appreciated


Posted by John Piccolo on August 05, 2001 4:04 AM

I guess I should post the Macro:

Sub CopyDupes()
'Written by Ozgrid Business Applications
'www.ozgrid.com
Dim rList1 As Range
Dim rList2 As Range
Dim rCell As Range

Application.ScreenUpdating = False
Set rList1 = Range("A2", Range("A65536").End(xlUp))
Set rList2 = Range("C2", Range("C65536").End(xlUp))

For Each rCell In rList1
With WorksheetFunction
If .CountIf(rList2, rCell) <> 0 And _
.CountIf(Sheets("Copy").Columns(1), rCell) = 0 Then
rCell.Range("A1:B1").Copy _
Destination:=Sheets("Copy").Range("A65536").End(xlUp).Offset(1, 0)
rList2.Find _
(What:=rCell, after:=rList2.Cells(1, 1)).Range("A1:B1").Copy _
Destination:=Sheets("Copy").Range("C65536").End(xlUp).Offset(1, 0)
End If
End With
Next rCell


Set rList1 = Nothing
Set rList2 = Nothing
Application.ScreenUpdating = True
End Sub


Dave,

Posted by steve w on August 05, 2001 10:20 AM

Just change the ranges refering to c to e and the range "A1:B1" to "A1:D1" and that should do it.

steve w

Sub CopyDupes()
'Written by Ozgrid Business Applications
'www.ozgrid.com
Dim rList1 As Range
Dim rList2 As Range
Dim rCell As Range

Application.ScreenUpdating = False
Set rList1 = Range("A2", Range("A65536").End(xlUp))
Set rList2 = Range("E2", Range("E65536").End(xlUp))

For Each rCell In rList1
With WorksheetFunction
If .CountIf(rList2, rCell) <> 0 And _
.CountIf(Sheets("Copy").Columns(1), rCell) = 0 Then
rCell.Range("A1:D1").Copy _
Destination:=Sheets("Copy").Range("A65536").End(xlUp).Offset(1, 0)
rList2.Find _
(What:=rCell, after:=rList2.Cells(1, 1)).Range("A1:D1").Copy _
Destination:=Sheets("Copy").Range("E65536").End(xlUp).Offset(1, 0)
End If
End With
Next rCell


Set rList1 = Nothing
Set rList2 = Nothing
Application.ScreenUpdating = True
End Sub

Posted by John Piccolo on August 08, 2001 3:41 AM

Is there a way of using the TRIM command so as to only remove spaces from the rightmost of a cell, but to retain any doublespaces within a code? I am attempting to use the function to tidy up codes which typically look like this :-

AUA416---4SPIM--1-----

, where '-' signifies a space. The spaces after the final 1 are unwanted, but I need to keep the others. The TRIM command renders the above code as

AUA416-4SPIM-1

which isn't much help to me unfortunately!

Any suggestions would be greatly appreciated......


Posted by John A Piccolo on August 15, 2001 11:41 AM

Steve W,

It Works! Thanks Much!

I have one more question, is there a way to easily find the items that don’t match up so I can include them with the end results?

Thanks again.