the hard way

[Rpettis31]

I know there is probably a better way of doing this than what I have done and
I need some help. I am trying to compare values on one workbook to another
and update the main workbook. It seemed to work and then today someone
notice that some of the values are duplicated. For example the value for
item a was looked up but then the next 2 rows have the same values. I am
assuming it is how I have approached the code.

Workbooks.Open Filename:= _
"G:\POS Analysis\Wal-Mart POS Reports\ITEMVENDORCROSS.XLS"


For z = 2 To 800


CurrItem = Cells(z, 1)


Workbooks("ITEMVENDORCROSS.XLS").Activate
Sheets("CrossRef").Select

For xx = 1 To 4000

If Cells(xx, 2) = CurrItem Then
OurItem = Cells(xx, 3)
End If

Next xx

Workbooks("POS Raw Data WMUS Template.xls").Activate
Sheets("Sheet1").Select

Cells(z, 3) = OurItem

Next z

' Close Cross Reference file
Application.CutCopyMode = False
Workbooks("ITEMVENDORCROSS.XLS").Close savechanges:=False

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Dave Peterson]

Maybe...

Option Explicit
Sub testme02()

Dim ItemWkbk As Workbook
Dim ItemWks As Worksheet
Dim RngToMatch As Range
Dim res As Variant
Dim ActWks As Worksheet
Dim RngToCheck As Range
Dim myCell As Range

Set ActWks = ActiveSheet 'the one that's active right now!
'or be explicit:
Set ActWks = Workbooks("POS Raw Data WMUS Template.xls") _
.Worksheets("Sheet1")

Set ItemWkbk = Workbooks.Open(Filename:= _
"G:\POS Analysis\Wal-Mart POS Reports\ITEMVENDORCROSS.XLS")
Set ItemWks = ItemWkbk.Worksheets("crossref")

With ItemWks
Set RngToMatch = .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
End With

With ActWks
Set RngToCheck = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In RngToCheck.Cells
res = Application.Match(myCell.Value, RngToMatch, 0)
If IsNumeric(res) Then
'a match was found
myCell.Offset(0, 1).Value = RngToMatch(res).Offset(0, 1).Value
Else
'no match, give a warning???
myCell.Offset(0, 1).Value = "No match???"
End If
Next myCell

End Sub


========
Untested, but it did compile.

application.match() is the =match() worksheet function.

It's pretty quick when you're looking for a match.

 

[JLGWhiz]

One suggestion would be to put an Exit For in the nested loop so that when
you get a hit (match) it does not continue to loop for that item, but goes
on to the next criteria to search.

For xx = 1 To 4000

If Cells(xx, 2) = CurrItem Then
OurItem = Cells(xx, 3)
Exit For
End If

Next xx

Otherwise, if there is more than one matching entry CurrItem, you will get
the value of Cells(xx, 3) for the last entry.

As for the duplicates, the only thing i can see is that there already were
duplicates, because your code moves one line on each iteration for both
loops.

 

[Rpettis31]

Dave help me to understand this line.
myCell.Offset(0, 1).Value = RngToMatch(res).Offset(0, 1).Value

Thanks
Robert

 

[Rpettis31]

Maybe that would help because I am not sure why it works for most of the list
there are no duplicates yet it seems to get stuck or something in the loop
not clearing the value.

 

[Dave Peterson]

If mycell is A99, then mycell.offset(0,1) is B99

If the match occurred on row 888, then rngtomatch(888).offset(0,1) is one column
to the right of the matching cell.

 

[Rpettis31]

Thank you for the explaination.

If mycell is A99, then mycell.offset(0,1) is B99

If the match occurred on row 888, then rngtomatch(888).offset(0,1) is one column
to the right of the matching cell.