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 its 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 dont match up so I can include them with the end results?
Thanks again.
