Macro To Compare Column Value, Against Row Value In Another Workbook - Code Supplied

[excelnube]

Hi guys,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I'm trying to write a macro that will loop through the values in Column F in wkbk1 (names of a product e.g. Plate) against the values in Row 6 in wkbk2( also names of a product e.g. Plate).<o></o>
<o> </o>
Once a match is found, copy this month’s price – found in wkbk2, row 16 for October, 17 for November etc..<o></o>
<o></o>
I know how to compare columns to columns, but columns to rows is causing a bit of difficulties. Here is my code:<o></o>

[FONT=Times New Roman][SIZE=3]Sub Update_Macro()[/SIZE][/FONT]
<o:p>[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Times New Roman]    Dim sh1 As Worksheet[/FONT][/SIZE]
<o:p>[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Times New Roman]    Set sh1 = Worksheets("Product List")[/FONT][/SIZE]
<o:p>[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Times New Roman]    Set VolumeData = Workbooks.Open(Filename:="C:\Documents and Settings\vince\Desktop\workbook2.xls"). _[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]           Worksheets("value data")[/FONT][/SIZE]
<o:p>[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Times New Roman]    lastrow1 = sh1.Cells(Rows.Count, "F").End(xlUp).Row[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    lastrow4 = VolumeData.Cells(6, Colls.Count).End(xlToLeft).Column[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]            [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    For i = 2 To lastrow1[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]        For j = 2 To lastrow4[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]'           If value in wkbk1 Column F is equal to wkbk 2 row 6 +[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]            If sh1.Cells(i, "F").Value = VolumeData.Cells(6, j).Value Or _[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]                sh1.Cells(i, "A").Value = VolumeData.Cells(7, j).Value Then[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3]'              Copy Value[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]               sh1.Cells(i, "M").Value = sh2.Cells(16, "B").Value[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]               [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]            End If[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]        Next j[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    Next i[/FONT][/SIZE]
<o:p>[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]</o:p>
[FONT=Times New Roman][SIZE=3]End Sub[/SIZE][/FONT]

Any help is appreciated.
Thanks

 

[NearlyMad]

somebody else may come along with a more elegant solution but I would use ".find"

use the first loop to determine the value to search for. i.e. set a variable that is the name of the product to search for.

Then using .find find the corresponding column number.

You then would need to determine which month you want to return the price from so another variable to set the month. use .find to get the corresponding row number for the month and you have the cell reference to return the price to the first spreadsheet.

 

[excelnube]

Anyone able to provide some code for me to work through??

 

[NearlyMad]

Anyone able to provide some code for me to work through??

if your data is layed out something like this on sheet2

Plates Saucers knives forks spoons
january 5.5 3.4 2.1 1.5 1.1
february 5.6 3.5 2.2 1.6 1.2
march 5.7 3.6 2.3 1.7 1.3
april 5.8 3.7 2.4 1.8 1.4
may 5.9 3.8 2.5 1.9 1.5
june 6 3.9 2.6 2 1.6
july 6.1 4 2.7 2.1 1.7
august 6.2 4.1 2.8 2.2 1.8
september 6.3 4.2 2.9 2.3 1.9
october 6.4 4.3 3 2.4 2
november 6.5 4.4 3.1 2.5 2.1

and a list on sheet1
Plates
Saucers
knives
forks
spoons


then something like this would work

Sub test()
mth = MonthName(Month(Now()))

For x = 1 To 5

Item = Sheets(1).Range("A" & x).Value

With Sheets(2).Rows("1:1")
Set a = .Find(Item, LookIn:=xlValues, lookat:=xlWhole)
If Not a Is Nothing Then
acol = a.Column
End If
End With
With Sheets(2).Columns("a:a")
Set b = .Find(mth, LookIn:=xlValues, lookat:=xlWhole)
If Not b Is Nothing Then
brow = b.Row
End If
End With



Sheets(1).Range("B" & x).Value = Sheets(2).Cells(brow, acol).Value
Next

End Sub

hope this helps

 

[excelnube]

Thanks for the above, NearlyMad.

I gave it a go, with some alterations, and most of the code works. However, when the code is attempting to copy the value of column F (plates for example), it reproduces column E's value.. It reproduces column E's value for coulmn G and H too.. I have double checked the spelling of the items i am trying to match and they are exact.

[FONT=Times New Roman][SIZE=3]Dim sh1 As Worksheet, QuantityData As Worksheet[/SIZE][/FONT]
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p>[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Times New Roman]    Set sh1 = Worksheets("Cutlery")[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]    [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    mth = MonthName(Month(Now()))[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]    [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    'MsgBox mth[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]    [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    Set QuantityData = Workbooks.Open(Filename:="C:\Documents and Settings\vince\Desktop\workbook2.xls"). _[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]         Worksheets("valueData")[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]    [/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3]'   Start at value x (2)[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    For x = 2 To 10[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]    [/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3]'   Perform the search on column F[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    Item = sh1.Range("F" & x).Value[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]    [/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3]'   Starting comparing Item ^^ against Column 2 Row 6[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    With QuantityData.Rows("2:7")[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    Set a = .Find(Item, LookIn:=xlValues, lookat:=xlWhole)[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    If Not a Is Nothing Then[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    acol = a.Column[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    End If[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    End With[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]    [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    With QuantityData.Columns("a:a")[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    Set b = .Find(mth, LookIn:=xlValues, lookat:=xlWhole)[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    If Not b Is Nothing Then[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    brow = b.Row[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    End If[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    End With[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]        [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    sh1.Activate[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]        [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    sh1.Range("M" & x).Value = QuantityData.Cells(brow, acol).Value[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]    [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    Next[/FONT][/SIZE]

Any help welcome

 

[NearlyMad]

Hi

Not entirely certain because I am not sure how your data is laid out but possibly on the first ".find" you are looking at several rows. Try searching on one row only. i.e. the row that has the data you are searching for.

 

[excelnube]

Hi,

I have attached screen shots of the file layout:

Workbook1:

Workbook2:

Hope that helps

 

[excelnube]

A little bump.. Still causing me a bit of a headache

 

[excelnube]

Bumping...

 

[NearlyMad]

Sub test()
mth = Month(Now) & "-" & Year(Now)
mth = Format(mth, "Mmm-yy")

For x = 2 To 7

Item = Sheets("cutlery").Range("F" & x).Value

With Sheets("valuedata").Rows("6:6")
Set a = .Find(Item, LookIn:=xlValues, lookat:=xlWhole)
If Not a Is Nothing Then
acol = a.Column
End If
End With
With Sheets("valuedata").Columns("a:a")
Set b = .Find(mth, LookIn:=xlValues, lookat:=xlWhole)
If Not b Is Nothing Then
brow = b.Row
End If
End With



Sheets("cutlery").Range("m" & x).Value = Sheets("valuedata").Cells(brow, acol).Value
Next

End Sub

This code should work - you may need to reference the workbooks if the sheets are in different workbooks but otherwise it should be ok