macro to check if value is in another list, and if so add today's date

Question

I have two excel sheets, A which contains products and B, which is the products we will discontinue when stock runs out.

I would like a macro so that we can make a list in B, hit the run function, and it will go and find where it is in sheet A, go to column E of that row and enter in today's date.

The hitch I have so far, is to not make it overwrite previous entries in the column if it wasn't found.

The basic formula I have right now is this

Sub Deletions()
Dim LastRow As Long
With Sheets("A")   '<-set this worksheet reference properly
    LastRow = .Range("A" & Cells.Rows.Count).End(xlUp).Row
    With .Range("E2:E" & LastRow)
        .Formula = "=IF(A1='B'!A1,TODAY(),)"
      .Cells = .Value2
    End With
End With
End Sub

The reason I need to use VBA, is that we have over 100k items, and not everyone using this will know excel very well. So we want to be able to make a list, put it in excel, and click the macro button and voila.

Also, the list of removed items gets deleted afterwards, as the information is kept in sheet A. We also need to keep the dates of when products got discontinued, so it is very crucial that this macro not erase previous entries.

Answer 1

Heres my answer: Please follow the comments inside the code.

Sub discontinue_Prods()
    'the button need to be on sheet B
    'In sheet B need to have a header
    Dim r
    Dim c
    Dim disRange As Range
    Dim i
    Dim shtA As Worksheet
    Dim shtB As Worksheet
    Dim dLine
    Dim E               'to store the column number of column E
    Dim A               'to store the column number of column A

    Set shtA = Sheets("A") 'storing the sheets...
    Set shtB = Sheets("B")

    shtB.Activate 'no matter you are in the workbook, always run from the sheet B,
                  'this code will do that for you.

    r = Range("A2").End(xlDown).Row 'the last row of the list
                                    'with the discounted prods
                                    'If you do not want headers,
                                    'use A1 here
    c = 1 'column A... changed if you need
    Set disRange = Range(Cells(2, c), Cells(r, c)) 'here need to change the 2 for
                                                   '1 if you do not want headers
    E = 5 'column E and A, just the numbers
    A = 1

    shtA.Activate 'go to sheet A
    For Each i In disRange 'for each item inside the list of prod going to discount
        dLine = Empty
        On Error Resume Next
        dLine = Application.WorksheetFunction.Match(i.Value, shtA.Columns(A), False)
        'here we find the row where the prod is,
        'searching for the item on the list (Sheet B).
        If Not dLine = Empty Then
            shtA.Cells(dLine, E).Value = Date 'heres we add the today date (system date)
                                         'to column E, just as text
            'IMPORTANT!
            'if you want the formula uncomment and use this:
            'Cells(dLine, E).FormulaR1C1 = "=TODAY()"
        End If
        On Error GoTo 0
    Next i
End Sub

Just go over the cells in the list of Sheet B, and go to Sheet A and find the products, and if the code find any Match product, set the column E as a Todays date, using the system date. Note, if you want to user formulas see the comments.

With a list like this:

Sheet A

+----------+-----+
| Products | Qty |
+----------+-----+
| Prod001  |  44 |
| Prod002  |  27 |
| Prod003  |  65 |
| Prod004  | 135 |
| Prod005  |  95 |
| Prod006  |  36 |
| Prod007  | 114 |
| Prod008  |  20 |
| Prod009  | 107 |
| Prod010  |   7 |
| Prod011  |  22 |
| Prod012  | 142 |
| Prod013  |  99 |
| Prod014  | 144 |
| Prod015  | 150 |
| Prod016  |  44 |
| Prod017  |  57 |
| Prod018  |  64 |
| Prod019  |  17 |
| Prod020  |  88 |
+----------+-----+


Sheet B

+----------+
| Products |
+----------+
| Prod017  |
| Prod011  |
| Prod005  |
| Prod018  |
| Prod006  |
| Prod009  |
| Prod006  |
| Prod001  |
| Prod017  |
+----------+

Result in Sheet A


+----------+-----+--+--+-----------+
| Products | Qty |  |  |           |
+----------+-----+--+--+-----------+
| Prod001  |  44 |  |  | 2/23/2016 |
| Prod002  |  27 |  |  |           |
| Prod003  |  65 |  |  |           |
| Prod004  | 135 |  |  |           |
| Prod005  |  95 |  |  | 2/23/2016 |
| Prod006  |  36 |  |  | 2/23/2016 |
| Prod007  | 114 |  |  |           |
| Prod008  |  20 |  |  |           |
| Prod009  | 107 |  |  | 2/23/2016 |
| Prod010  |   7 |  |  |           |
| Prod011  |  22 |  |  | 2/23/2016 |
| Prod012  | 142 |  |  |           |
| Prod013  |  99 |  |  |           |
| Prod014  | 144 |  |  |           |
| Prod015  | 150 |  |  |           |
| Prod016  |  44 |  |  |           |
| Prod017  |  57 |  |  | 2/23/2016 |
| Prod018  |  64 |  |  | 2/23/2016 |
| Prod019  |  17 |  |  |           |
| Prod020  |  88 |  |  |           |
+----------+-----+--+--+-----------+

Answer 2

This is what I would do:

Dim b as Variant
For j=1 to Range("A1").End(xlDown).Row 'Assuming the button is on the "B" Sheet
   b=Cells(j,1).Value 'This is your product in Sheet "B", assuming it is in the first column
   For i=1 to Sheets("A").Range("A1").End(xlDown).Row
      If Sheets("A").Cells(i,1).Value=b Then 'This would mean the product was found in the i Row
         Sheets("A").Cells(i,5)=Format(Now(), "MMM-DD-YYYY") 'Write today's date
      Exit For 'No need to keep looping
      End if
   Next i
Next j

It's very basic, but I'm sure it works.

Answer 3

I think you are overcomplicating this by using VBA.

Instead, you can do this with a simple Excel formula:

Assume 'Sheet B', column A holds the list of discontinued items. 'Sheet A' column A holds the name of each item, and you want today's date in column E, wherever there is a match of an item in Sheet B. Put this in 'Sheet A' E1 and copy it down to the end of the sheet.

=IF(ISERROR(MATCH(A1,'Sheet B'!A:A, 0)), "", TODAY())

This will put today's date, as long as the row in sheet A matches any of the rows in sheet B. It tries to find a match anywhere on Sheet B, and if it doesn't, it will produce an error, meaning ISERROR will be TRUE, and the IF statement will produce "". If it does match, there will be no error, and it will produce TODAY().