Map data based on effective date

[richlyn9]

Hi All,
I am unable to figure out how do i map data based on effective date
i have a record with transaction date, owner of transaction and another table which maps owner with department and effective date which tell me if an owner was transferred to a different dept and its effective date.
Hence when i am doing a simple lookup the dept mapping on the first table will change the values when the dept changes.

i am trying to build this on excel or access if possible to save time as data is large (25 MB file).

 

[oldbrewer]

I must be missing something here - your second table is present dept and effective date - so why do you need first table at all ?

 

[richlyn9]

I must be missing something here - your second table is present dept and effective date - so why do you need first table at all ?

Second table will have older dept mapping as well,
so for the records in the first table prior to dept change i want to retain the older dept for any such instances.

Table 1

Transaction Date | Owner
10/31/16 ABC
10/16/16 ABC

Table 2
Owner | Dept | Effective date
ABC 123 10/20/16
ABC 456 09/20/16


so when i map dept in Table 1, i should get 456 for the 1st record and 123 for the second.

 

[oldbrewer]

date	owner	curr dept						owner	dept	eff date
28/10/2016	abc	777						abc	123	20/10/2016
15/10/2016	def	456						def	456	15/10/2016
								abc	777	28/10/2016
					this macro has populated the date and curr dept columns
					by working through the table on the right
					it assumes dates are in ascending order
					if they are not extra code will be needed to sort into ascending order
					For j = 2 To 3
					For k = 2 To 4
					If Cells(k, 9) = Cells(j, 2) Then temp = Cells(k, 11): dept = Cells(k, 10)
					Next k
					Cells(j, 1) = temp
					Cells(j, 3) = dept
					Next j
					End Sub

<colgroup><col><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

 

[richlyn9]

the below code works in excel, where both the tables are in to different sheet of the same woorbook
now to write this in access.


Public Sub test()
Sheets("Sheet1").Activate
lrow1 = Cells(Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B2:B" & lrow1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("A2:A" & lrow1), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Casesview").Activate
lrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lrow
cnt = Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("B:B"), Cells(i, "I").Value)
CreatedDate = Cells(i, "f").Value

FindString = Cells(i, "I").Value

For j = 1 To cnt
Sheets("Sheet1").Activate
With Sheets("Sheet1").Range("B:B")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
If cnt = 1 Then
Sheets("CasesView").Range("AD" & i) = ActiveCell.Offset(0, 1).Value
Sheets("CasesView").Range("AE" & i) = ActiveCell.Offset(0, 2).Value
Sheets("CasesView").Range("AF" & i) = ActiveCell.Offset(0, 3).Value
Sheets("CasesView").Range("AG" & i) = ActiveCell.Offset(0, 4).Value
Sheets("CasesView").Range("AH" & i) = ActiveCell.Offset(0, 5).Value
Else
If CreatedDate >= ActiveCell.Offset(j - 1, -1).Value Then
Sheets("CasesView").Range("AD" & i) = ActiveCell.Offset(0, 1).Value
Sheets("CasesView").Range("AE" & i) = ActiveCell.Offset(0, 2).Value
Sheets("CasesView").Range("AF" & i) = ActiveCell.Offset(0, 3).Value
Sheets("CasesView").Range("AG" & i) = ActiveCell.Offset(0, 4).Value
Sheets("CasesView").Range("AH" & i) = ActiveCell.Offset(0, 5).Value
End If
End If
Sheets("CasesView").Activate
Next
Next
End Sub

 

[richlyn9]

My data runs in to over 60, 000 rows and hence this is dosent seem like a very good solution to me.
Can such a thing be done in Power BI or access?