Macro To Compare Values In Two Workbooks, Then Paste A Value

[excelnube]

Hi guys,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
Trying to write a simple compare and match macro.<o> </o>
I have two workbooks – Manufacture.xls and Overview.xls.<o> </o>
Manufacture.xls has two sheets. One is titled “Makes” which colA displays a small list of car manufactures e.g. Honda, Nissan, Skoda etc. The other sheet titled “Pricing” with colA replicating the information within cola within “Makes”. “Pricing” also has colB which should display an abbreviation for the manufacture – the abbreviations are stored within Overview.xls.<o> </o>
Overview.xls has a sheet titled “Budget”. colA displays a full list of all car manufactures. colF displays an abbreviation for each manufacture e.g. Honda = HON.<o> </o>
I am trying to write a macro that will read the second row in colA within Manufacture.xls. Perform a search to see if the value is in colA within Overview.xls, it is, copy the corresponding abbreviation from colF and paste it to colB within Manufacture.xls. Then, read the third row in colA within Manufacture.xls etc...<o></o>
<o> </o>This is what I have tried so far:

[FONT=Times New Roman]Dim CompareRange As Variant, x As Variant, y As Variant<o:p></o:p>[/FONT]
<o:p>[FONT=Times New Roman] [/FONT]</o:p>
[FONT=Times New Roman]    Set CompareRange = Workbooks.Open(Filename:="C:\Documents and Settings\jaceLee\Desktop\ Overview.xls"). _<o:p></o:p>[/FONT]
[FONT=Times New Roman]       Worksheets("Budget").Range("A2:A50")<o:p></o:p>[/FONT]
<o:p>[FONT=Times New Roman] [/FONT]</o:p>
[FONT=Times New Roman]    ' Loop through each cell in the selection and compare it to<o:p></o:p>[/FONT]
[FONT=Times New Roman]    ' each cell in CompareRange.<o:p></o:p>[/FONT]
[FONT=Times New Roman]    For Each x In Selection<o:p></o:p>[/FONT]
[FONT=Times New Roman]        For Each y In CompareRange<o:p></o:p>[/FONT]
[FONT=Times New Roman]            If x = y Then x.Offset(0, 1) = x<o:p></o:p>[/FONT]
[FONT=Times New Roman]        Next y<o:p></o:p>[/FONT]
[FONT=Times New Roman]    Next x<o:p></o:p>[/FONT]

The above code doesn’t appear to work.<o> </o>
Any help is appreciated.<o> </o>
Thanks

 

[excelnube]

Bump..

Any suggestions?

 

[excelnube]

Just tried a new piece of code an still can't get it to work

    Sheets("Sheet1").Select
'   Columns("A").Select
    Range("A1:A6").Select
    Selection.Copy
 
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    'Range("A1").Select
 
    Dim PartRngSheet1 As Range, PartRngSheet2 As Range
    Dim lastRowSheet1 As Long, lastRowSheet2 As Long
    Dim cl As Range, rng As Range
     
    lastRowSheet1 = Worksheets("Sheet2").Range("A65536").End(xlUp).Row
    Set PartRngSheet1 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet1)
     
    
    'lastRowSheet2 = Worksheets("Sheet2").Range("B65536").End(xlUp).Row
     lastRowSheet2 = Workbooks.Open(Filename:="C:\Documents and Settings\jaceLee\Desktop\Overview.xls"). _
               Worksheets("Budget").Range("A6553").End(xlUp).Row
    
    'Set PartRngSheet2 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet2)
     Set PartRngSheet2 = Workbooks.Open(Filename:="C:\Documents and Settings\jaceLee\Desktop\Overview.xls"). _
               Worksheets("Budget").Range("A1:A" & lastRowSheet2)
    
    For Each cl In PartRngSheet1
        For Each rng In PartRngSheet2
            If (cl = rng) Or (cl = rng.Offset(0, 1)) Then
                rng.Offset(0, 2) = cl.Offset(0, 1)
            End If
        Next rng
    Next cl

 

[John Davis]

Just tried a new piece of code an still can't get it to work

    Sheets("Sheet1").Select
'   Columns("A").Select
    Range("A1:A6").Select
    Selection.Copy
 
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    'Range("A1").Select
 
    Dim PartRngSheet1 As Range, PartRngSheet2 As Range
    Dim lastRowSheet1 As Long, lastRowSheet2 As Long
    Dim cl As Range, rng As Range
     
    lastRowSheet1 = Worksheets("Sheet2").Range("A65536").End(xlUp).Row
    Set PartRngSheet1 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet1)
     
    
    'lastRowSheet2 = Worksheets("Sheet2").Range("B65536").End(xlUp).Row
     lastRowSheet2 = Workbooks.Open(Filename:="C:\Documents and Settings\jaceLee\Desktop\Overview.xls"). _
               Worksheets("Budget").Range("A6553").End(xlUp).Row
    
    'Set PartRngSheet2 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet2)
     Set PartRngSheet2 = Workbooks.Open(Filename:="C:\Documents and Settings\jaceLee\Desktop\Overview.xls"). _
               Worksheets("Budget").Range("A1:A" & lastRowSheet2)
    
    For Each cl In PartRngSheet1
        For Each rng In PartRngSheet2
            If (cl = rng) Or (cl = rng.Offset(0, 1)) Then
                rng.Offset(0, 2) = cl.Offset(0, 1)
            End If
        Next rng
    Next cl

Do you want the information transferred from Overview Col F to go Manufacturers-Sheets("Makes") Column B?