Auto copy new data entered based on non-duplicative data in a different sheet

[SewStage]

Hi. I'm looking for a way to automatically add the Date and Destination on the Mileage Log worksheet from the Date of Purchase and Company cells on Material Purchases worksheet every time I add a new entry; but 1) only if Online column does not have an X, and 2) only add unique combinations of Date of Purchase and Company (so I don't have a ton of duplicates). Ultimately looking for a way to not manually enter all my mileage if I can link it back to the dates of the physical purchases. Thanks much.

2021 Inventory Management.xlsx
	A	B
1	Date	Destination
2	1/19/2021	Target
3	1/15/2021	Home Depot
4	1/19/2022	Michaels
5	1/23/2021	Affinity
6	1/23/2021	Costco
7	1/23/2021	Joann Fabrics
8	1/26/2021	Hobby Lobby
9	1/26/2021	Joann Fabrics
10	1/28/2021	Affinity
11	1/28/2021	Joann Fabrics
12	1/30/2022	Affinity
Mileage Log

2021 Inventory Management.xlsx
	A	B	C	D	E	F	G	H	I
1	Category	Description	Details	Cost	Units	Per Unit Cost	Company	Date of Purchase	Online
24	Kits	Quilt kit	Holiday Hearthland Advent Calendar	$ 46.01	1	$ 46.01	MSQC	1/16/2021	X
25	Shipping	shipping		$ 5.00			MSQC	1/16/2021	X
26	Notions	Notions	Longarm centering tape	$ 21.24			Amazon	1/17/2021	X
27	Notions	Notions	gnome embellishments	$ 29.45			Michaels	1/19/2021
28	Socks	Socks	Fuzzy socks	$ 12.00	6	$ 2.00	Target	1/19/2021
29	Fabric	Fabric	Andover by the Sea (for Ribbons quilt)	$ 81.60	8	$ 10.20	Jordan Fabrics	1/20/2021	X
30	Fabric	Layer cake	Andover by the Sea (for Ribbons quilt)	$ 29.95	1	$ 29.95	Jordan Fabrics	1/20/2021	X
31	Socks	Socks	Gnome socks	$ 8.97	6	$ 1.50	Joann Fabrics	1/22/2021	X
32	Fabric	Cork	18x27	$ 78.00	1.5	$ 52.00	Affinity	1/23/2021
33	Fabric	Fabric		$ 44.75	3.5	$ 12.79	Affinity	1/23/2021
34	Fabric	FQ		$ 6.50	2	$ 3.25	Affinity	1/23/2021
35	Fabric	Fabric	Loyalty card	$ (50.00)			Affinity	1/23/2021
36	Fabric	Fabric	Discount + tax	$ (15.43)			Affinity	1/23/2021
37	Notions	Rice	rice	$ 9.99	400	$ 0.02	Costco	1/23/2021
38	Notions	Notions		$ 18.67			Joann Fabrics	1/23/2021
39	Fabric	Fabric	Custom placemats	$ 18.50	2	$ 9.25	Joann Fabrics	1/23/2021
40	Notions	Notions	Discount + tax	$ (5.24)			Joann Fabrics	1/23/2021
41	Fabric	Jelly roll	Moda Solana	$ 36.95	1	$ 36.95	Jordan Fabrics	1/23/2021	X
42	Notions	Notions	Cross My Heart pattern	$ 9.95			Jordan Fabrics	1/23/2021	X
43	Shipping	shipping		$ 4.95			Jordan Fabrics	1/23/2021	X
44	Fabric	Layer cake	Chocolicious	$ 26.95	1	$ 26.95	Jordan Fabrics	1/24/2021	X
45	Shipping	shipping		$ 4.95			Jordan Fabrics	1/24/2021	X
46	Notions	Notions	gnome embellishments	$ 12.99			Hobby Lobby	1/26/2021
47	Notions	Notions	gnome embellishments	$ 17.97			Joann Fabrics	1/26/2021
48	Fabric	Fabric		$ 20.67	2.25	$ 9.19	Joann Fabrics	1/26/2021
Material purchases

Cell Formulas
Range	Formula
D29	D29	=111.55-29.95
D32	D32	=26*3
D33	D33	=6.5*6+5.75
D36	D36	=-19.81+4.38
E37	E37	=16*25
D38	D38	=10.19+3.49+4.99
D39	D39	=SUM(3.5+3.5+6+5.5)
D40	D40	=-7.43+2.19
D47	D47	=5.99+5.99+5.99
D48	D48	=6.99+1.75+3.5+4+4.43
F24:F48	F24	=IF(E24>0,D24/E24,"")

 

[JW00]

Hi, this can be done with the worksheet change event, the thing is that only fires when you manually adjust a cells value, therefore in order to get the code to work the "Date Of Purchase" column has to be the last cell in which you enter data & it has to be done manually, not dragged or pasted, if you do that the following code should work for you.

Put the following code in a module;

Sub AddMilelageLog()
Dim ID As String, s1 As String, s2 As String
Dim WS As Worksheet, WS1 As Worksheet
Dim MatchingID As Long
Dim i As Long, LastRow As Long, MaxRow As Long
Dim SearchedValue As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    s1 = ActiveCell.Offset(-1, 0).Address
    s2 = ActiveCell.Offset(-1, -1).Address
    
    MaxRow = LastRowColumn("R")

    ID = ActiveCell.Offset(-1, 0).Value & "~" & ActiveCell.Offset(-1, -1)
    
    Set WS = Worksheets("Mileage Log")
    Set WS1 = Worksheets("Material purchases")
    
    For i = 1 To MaxRow
         If StrComp(WS.Range("A" & i).Value & "~" & WS.Range("B" & i).Value, ID, vbTextCompare) = 0 Then
              MatchingID = i
              Exit For
         End If
    Next i
    
    If i > MaxRow Then
        WS.Select
        WS.Cells(2, 1).Select
        LastRow = LastRowColumn("R") + 1
        WS.Cells(LastRow, 1).Value = WS1.Range(s1).Value
        WS.Cells(LastRow, 2).Value = WS1.Range(s2).Value
    End If
    
    WS1.Select
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub
Function LastRowColumn(RowColumn As String) As Long
Dim sht As Worksheet
'PURPOSE: Function To Return the Last Row Or Column Number In the Active Spreadsheet
'INPUT: "R" or "C" to determine which direction to search
Set sht = ActiveSheet

Select Case LCase(Left(RowColumn, 1)) 'If they put in 'row' or column instead of 'r' or 'c'.
  Case "c"
    LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column
  Case "r"
    LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row
  Case Else
    LastRowColumn = 1
End Select

End Function

Put this code behind sheet "Material purchases" & the code will run each time you enter a date.

Private Sub Worksheet_Change(ByVal Target As Range)
    With Sheets("Material purchases")
        If Not Intersect(Target, Range("H:H")) Is Nothing Then
            If ActiveCell.Offset(-1, 1) = "X" Or ActiveCell.Offset(-1, 1) = "2" Or ActiveCell.Offset(-1, 1) = 2 Then
               Exit Sub
            Else
               Call AddMilelageLog
            End If
        End If
    End With
End Sub

 

[SewStage]

Thank you so much for taking the time to respond, JW00, but even though I DID spend 30+ years in IT I'm not a developer and have no knowledge of VBA, unfortunately. What I've done for now is just create a pivot table and manually delete dups, which is still a lot quicker than manually entering hundreds of entries.

Again, thanks much; truly appreciate it!

 

[JW00]

No problem & thanks for your kind words, I noticed you are using 365 so try this formula in A2 in a new sheet, it may just save you some time.

=UNIQUE(FILTER('Material purchases'!G:H,('Material purchases'!I:I="")*('Material purchases'!G:G<>0)))

 

[SewStage]

I am so jealously in awe of all of you that know this stuff!!! That worked perfectly; THANK YOU!

 

[JW00]

I'm glad it is working for you, all the best.

 

[SewStage]

Now if you want a bigger challenge you could always take a peek at my last post: https://www.mrexcel.com/board/threads/streamlining-a-long-manual-formula.1195188/; this is the bane of my existence.