VBA If a cell value is found in a named range and not in others then

[cg1576]

Hi,
I have a list that contains many names of products (about 20k). I need to input the status (three options: bought, sold, expired).
[TABLE="width: 128"]
<colgroup><col span="2"></colgroup><tbody>[TR]
[TD="align: left"]A
Name[/TD]
[TD="align: left"]B
Status[/TD]
[/TR]
[TR]
[TD="align: left"]Apple[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: left"]Orange[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2, align: left"]Pineapple[/TD]
[/TR]
</tbody>[/TABLE]

I also have a list of bought, sold and expired items that are on separate sheets (respectively named Bought, Sold, Expired), I have also created named ranges out of each if this helps. The catch is that an item, let's say 'apple' can be in bought, sold and expired.

I would like to have a macro that would loop through each item on the list and check if they are in the named range with the following priorities:

If they are in bought, but not in sold or expired, status should return: Bought
If they are in sold, but not in expired, status should be: Sold
If they are in expired, status should be: Expired
If they are in none, leave status empty

It would then loop through each until the end of the list.

I would appreciate any help on this, I am relatively new at this.

Thanks
CG

 

[Fluff]

Is you list of items unique, or can Apple occur more than once?
Also
What are the names of your sheets?
Are the items & status in columns A & B starting in row2?

 

[cg1576]

Is you list of items unique, or can Apple occur more than once?
Also
What are the names of your sheets?
Are the items & status in columns A & B starting in row2?

Yes the Items are unique, they never occur more than once within that list.

The list of all items is in sheet Tracker, the bought items is in Bought, sold items is in Sold and the expired items is in Expired sheet.

The items in Tracker start on row 2.

But the items in bought sold and expired each start on row 1, in column A.

 

[Fluff]

How about

Sub getstatus()
   Dim Shts As Variant
   Dim sht As Worksheet
   Dim cl As Range
   
   Set Shts = Sheets(Array("Bought", "Sold", "Expired", "Tracker"))
   With CreateObject("scripting.dictionary")
      For Each sht In Shts
         If Not sht.Name = "Tracker" Then
            For Each cl In sht.Range("A1", sht.Range("A" & Rows.Count).End(xlUp))
               If Not .exists(cl.Value) Then
                  .Add cl.Value, sht.Name
               Else
                  .Item(cl.Value) = sht.Name
               End If
            Next cl
         Else
            For Each cl In sht.Range("A2", sht.Range("A" & Rows.Count).End(xlUp))
               cl.Offset(, 1).Value = .Item(cl.Value)
            Next cl
         End If
      Next sht
   End With
End Sub

 

[cg1576]

How about

Sub getstatus()
   Dim Shts As Variant
   Dim sht As Worksheet
   Dim cl As Range
   
   Set Shts = Sheets(Array("Bought", "Sold", "Expired", "Tracker"))
   With CreateObject("scripting.dictionary")
      For Each sht In Shts
         If Not sht.Name = "Tracker" Then
            For Each cl In sht.Range("A1", sht.Range("A" & Rows.Count).End(xlUp))
               If Not .exists(cl.Value) Then
                  .Add cl.Value, sht.Name
               Else
                  .Item(cl.Value) = sht.Name
               End If
            Next cl
         Else
            For Each cl In sht.Range("A2", sht.Range("A" & Rows.Count).End(xlUp))
               cl.Offset(, 1).Value = .Item(cl.Value)
            Next cl
         End If
      Next sht
   End With
End Sub

This works great! Thanks a lot

 

[Fluff]

Glad to help & thanks for the feedback