VBA code for adding data from a sheet to 2 different sheets

[Atlantis764]

Hi all,

I'm trying to make some changes in a VBA code and I need your help.

The idea from which I initially started with this project was the following:
I made a User form in excel (Home sheet) in which I entered some data for a number of experts at the end of each month (the fields from the User Form were exactly the dates from the top row of the Database) for each expert at the end of each month.

Every time I save the data in the User form, they are automatically written as a new row in the Database sheet, the values from the "Worked hours" column to the correct position in Database1 and the values from the "Amount" column to the correct position in Database2.

I managed to make the VBA code so that all the steps above work correctly.

After about a year of working with this file and several hundred recordings in it, I realized that it is a repetitive work at the end of each month and that this activity is very time-consuming.

Reaching this moment (I admit that I should have thought faster) I thought that I could finish the job much faster if I actually copy-paste the previous data from the Database - rows previously entered (without entering the data in the User form) and just enter the data from the columns “Month”, “Worked hours” and “Amount” manually.

Is it possible to have a VBA code that every time I am manually add a new entry to Database sheet (not with the help of the User form) automatically search and add the values from Column H "Worked hours" in the corresponding cell from Database1 sheet and the values from Column I "Amount" in the corresponding cell from Database2 sheet-cell made with the same color?

What I'm trying to achieve is to have a VBA code that works and has the same result if I use the User form (the code already works) or if I enter the data manually in the Database sheet.

Another thing I encountered while working was the following: I deleted an entire row from the Database sheet, but the amounts initially added to the Database 1 and Database2 remained there. Do you think it is possible to help me with this change in the VBA code so that when I delete an amount from one column or another (or the entire row in Database), that amount is also deleted from the related database (Worked Hours in Database1 and Amount in Database 2)?

Thank you in advance for all your help!

Database_2023.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	S.No.	Year	Month	Date	Name	Activity	Sub-activity	Worked hours	Amount	User Name
2	1	2023	January	31/01/2023	John	A.1	A.1.2	100	1000	Liviu Popescu	11/03/2023 15:43
3	2	2023	March	31/03/2023	Anne	A.3	A.3.1	50	500	Liviu Popescu	11/03/2023 15:57
4	3	2023	February	28/02/2023	Mark	A.2	A.2.2	125	750	Liviu Popescu	11/03/2023 16:00
5	2	2023	February	28/02/2023	Anne	A.4	A.4.2
Database

Database_2023.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Name	Activity	Sub-activity	11/22	12/22	01/23	02/23	03/23	04/23	05/23	06/23
2	John	A.1	A.1.1
3	John	A.1	A.1.2			100
4	John	A.2	A.2.1
5	John	A.2	A.2.2
6	John	A.3	A.3.1
7	John	A.3	A.3.2
8	John	A.4	A.4.1
9	John	A.4	A.4.2
10	Mark	A.1	A.1.1
11	Mark	A.1	A.1.2
12	Mark	A.2	A.2.1
13	Mark	A.2	A.2.2				125
14	Mark	A.3	A.3.1
15	Mark	A.3	A.3.2
16	Mark	A.4	A.4.1
17	Mark	A.4	A.4.2
18	Anne	A.1	A.1.1
19	Anne	A.1	A.1.2
20	Anne	A.2	A.2.1
21	Anne	A.2	A.2.2
22	Anne	A.3	A.3.1					50
23	Anne	A.3	A.3.2
24	Anne	A.4	A.4.1
25	Anne	A.4	A.4.2
Database1

Database_2023.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Name	Activity	Sub-activity	11/22	12/22	01/23	02/23	03/23	04/23	05/23	06/23
2	John	A.1	A.1.1
3	John	A.1	A.1.2			1000
4	John	A.2	A.2.1
5	John	A.2	A.2.2
6	John	A.3	A.3.1
7	John	A.3	A.3.2
8	John	A.4	A.4.1
9	John	A.4	A.4.2
10	Mark	A.1	A.1.1
11	Mark	A.1	A.1.2
12	Mark	A.2	A.2.1
13	Mark	A.2	A.2.2				750
14	Mark	A.3	A.3.1
15	Mark	A.3	A.3.2
16	Mark	A.4	A.4.1
17	Mark	A.4	A.4.2
18	Anne	A.1	A.1.1
19	Anne	A.1	A.1.2
20	Anne	A.2	A.2.1
21	Anne	A.2	A.2.2
22	Anne	A.3	A.3.1					500
23	Anne	A.3	A.3.2
24	Anne	A.4	A.4.1
25	Anne	A.4	A.4.2
Database2

Sub Submit_Data()

    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim iRow As Long, colno As Integer, iCol As Long, rowno As Integer
    Dim iRow1 As Long, colno1 As Integer, iCol1 As Integer, reqdRow As Integer
    Dim iRow2 As Long, colno2 As Integer, iCol2 As Integer, reqdRow1 As Integer
    Set sh = ThisWorkbook.Sheets("Database")
    Set sh1 = ThisWorkbook.Sheets("Database1")
    Set sh2 = ThisWorkbook.Sheets("Database2")
    iRow = [Counta(Database!A:A)] + 1
    iCol = Sheets("Database").Cells(1, Columns.Count).End(xlToLeft).Column - 1
    iRow1 = [Counta(Database1!A:A)] + 1
    iCol1 = Sheets("Database1").Cells(1, Columns.Count).End(xlToLeft).Column - 1
    iRow2 = [Counta(Database2!A:A)] + 1
    iCol2 = Sheets("Database2").Cells(1, Columns.Count).End(xlToLeft).Column - 1
    
    Application.ScreenUpdating = False
    With sh
        .Cells(iRow, 1) = iRow - 1
        .Cells(iRow, 2) = UserForm1.CmbYear.Value
        .Cells(iRow, 3) = UserForm1.CmbMonth.Value
        .Cells(iRow, 4) = UserForm1.txtDate.Value
        .Cells(iRow, 5) = UserForm1.CmbName.Value
        .Cells(iRow, 6) = UserForm1.CmbActivity.Value
        .Cells(iRow, 7) = UserForm1.CmbSubActivity.Value
        .Cells(iRow, 8) = UserForm1.TxtHours.Value
        .Cells(iRow, 9) = UserForm1.txtAmount.Value
        .Cells(iRow, 10) = Application.UserName
        .Cells(iRow, 11) = Format([Now()], "DD-MMM-YYYY HH:MM:SS")
    End With

    With sh1
        For rowno = 2 To iRow1
            If .Cells(rowno, 1) = UserForm1.CmbName.Value And .Cells(rowno, 2) = UserForm1.CmbActivity.Value And .Cells(rowno, 3) = UserForm1.CmbSubActivity.Value Then
                reqdRow = rowno
                Exit For
            End If
        Next
        For colno = 4 To iCol1
            If UserForm1.CmbMonth.Value = Format(.Cells(1, colno), "MMMM") And _
            UserForm1.CmbYear.Value = Format(.Cells(1, colno), "YYYY") Then
            .Cells(reqdRow, colno) = UserForm1.TxtHours.Value
            End If
        Next
        .Cells(iRow, iCol1 + 3) = Application.UserName
    End With
    
    With sh2
        For rowno = 2 To iRow1
            If .Cells(rowno, 1) = UserForm1.CmbName.Value And .Cells(rowno, 2) = UserForm1.CmbActivity.Value And .Cells(rowno, 3) = UserForm1.CmbSubActivity.Value Then
                reqdRow = rowno
                Exit For
            End If
        Next
        For colno = 4 To iCol1
            If UserForm1.CmbMonth.Value = Format(.Cells(1, colno), "MMMM") And _
            UserForm1.CmbYear.Value = Format(.Cells(1, colno), "YYYY") Then
            .Cells(reqdRow, colno) = UserForm1.txtAmount.Value
            End If
        Next
        .Cells(iRow, iCol2 + 3) = Application.UserName
    End With
 
    Application.ScreenUpdating = True
 
    MsgBox "Date incarcate cu succes!"

End Sub

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your Database sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter a value in column H or column I and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("H:I")) Is Nothing Then Exit Sub
    Dim vDB As Variant, vDB1 As Variant, vDB2 As Variant, vDate1 As Variant, vDate2 As Variant
    Dim col As Long, lCol1 As Long, lcol2 As Long, v As Variant, i As Long, ii As Long, val1 As String, val2 As String
    Application.ScreenUpdating = False
    With Sheets("Database1")
        lCol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate1 = .Range("D1").Resize(, lCol1 - 3).Value
        vDB1 = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    With Sheets("Database2")
        lcol2 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate2 = .Range("D1").Resize(, lcol2 - 3).Value
        vDB2 = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    Select Case Target.Column
        Case Is = 8
            vDB = Range("B" & Target.Row).Resize(, 6).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate1
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 3
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 6)
            For ii = LBound(vDB1) To UBound(vDB1)
                val2 = vDB1(ii, 1) & "|" & vDB1(ii, 3)
                If val1 = val2 Then
                    Sheets("Database1").Cells(ii + 1, col) = Target.Value
                    Exit For
                End If
            Next ii
        Case Is = 9
            vDB = Range("B" & Target.Row).Resize(, 6).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate2
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 3
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 6)
            For ii = LBound(vDB2) To UBound(vDB2)
                val2 = vDB2(ii, 1) & "|" & vDB2(ii, 3)
                If val1 = val2 Then
                    Sheets("Database2").Cells(ii + 1, col) = Target.Value
                    Exit For
                End If
            Next ii
    End Select
    Application.ScreenUpdating = True
End Sub

 

[Atlantis764]

Hi Mumps,

Thank you for all your support!
The VBA code works great!

Best regards,
Liviu

 

[mumps]

You are very welcome.

 

[Atlantis764]

You are very welcome.

Hi Mumps,

I'm sorry to bother you again, but it seems that I need your help again.
I made some changes in Database1 and Database2 and I would be interested if you could help me (I tried but I can't manage it) with modifying the VBA code so that it only runs in a certain area of the two sheets (in this case, to run only in the range P26:W49 - from row 26 and from to column 16).
I try to give an example as detailed as possible:
- for the entry no 7 from Database sheet I have 2023, March, John, A.3, A.3.2 - the value from H8 cell must be added in cell T31 from Database1 (with yellow in both sheets) - 2023, March, John, A.3, A.3.2 is also in cell L7 but there I will add the number of allocated hours.
- for the entry no 7 from Database sheet I have 2023, March, John, A.3, A.3.2 - the value from I8 cell must be added in cell T31 from Database2 (with green in both sheets) - 2023, March, John, A.3, A.3.2 is also in cell L7 but there I will add the number of allocated budget.
Thanks again for your help!

Database_2023_modified.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	S.No.	Year	Month	Date	Name	Activity	Sub-activity	Worked hours	Amount	User Name
2	1	2023	January	31/01/2023	John	A.1	A.1.2	100	1000	Liviu Popescu	11/03/2023 15:43
3	2	2023	March	31/03/2023	Anne	A.3	A.3.1	50	500	Liviu Popescu	11/03/2023 15:57
4	3	2023	February	28/02/2023	Mark	A.2	A.2.2	125	750	Liviu Popescu	11/03/2023 16:00
5	2	2023	February	28/02/2023	Anne	A.4	A.4.2	200	850
6	5	2022	December	31/12/2022	Mark	A.1	A.1.2	75	650	Liviu Popescu	11/03/2023 23:34
7	6	2023	April	30/04/2023	Anne	A.2	A.2.1	500	5000
8	7	2023	March	31/03/2023	John	A.3	A.3.2
Database

Database_2023_modified.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	Name	Activity	Sub-activity	Additional field 1	Additional field 2	Additional field 3	Additional field 4	Bgt 01/11/2022	Bgt 01/12/2022	Bgt 01/01/2023	Bgt 01/02/2023	Bgt 01/03/2023	Bgt 01/04/2023	Bgt 01/05/2023	Bgt 01/06/2023	11/22	12/22	01/23	02/23	03/23	04/23	05/23	06/23
2	John	A.1	A.1.1
3	John	A.1	A.1.2							120
4	John	A.2	A.2.1
5	John	A.2	A.2.2
6	John	A.3	A.3.1
7	John	A.3	A.3.2
8	John	A.4	A.4.1
9	John	A.4	A.4.2
10	Mark	A.1	A.1.1
11	Mark	A.1	A.1.2						80
12	Mark	A.2	A.2.1
13	Mark	A.2	A.2.2								125
14	Mark	A.3	A.3.1
15	Mark	A.3	A.3.2
16	Mark	A.4	A.4.1
17	Mark	A.4	A.4.2
18	Anne	A.1	A.1.1
19	Anne	A.1	A.1.2
20	Anne	A.2	A.2.1										525
21	Anne	A.2	A.2.2
22	Anne	A.3	A.3.1									100
23	Anne	A.3	A.3.2
24	Anne	A.4	A.4.1
25	Anne	A.4	A.4.2								220
26	John	A.1	A.1.1
27	John	A.1	A.1.2															100
28	John	A.2	A.2.1
29	John	A.2	A.2.2
30	John	A.3	A.3.1
31	John	A.3	A.3.2
32	John	A.4	A.4.1
33	John	A.4	A.4.2
34	Mark	A.1	A.1.1
35	Mark	A.1	A.1.2														75
36	Mark	A.2	A.2.1
37	Mark	A.2	A.2.2																125
38	Mark	A.3	A.3.1
39	Mark	A.3	A.3.2
40	Mark	A.4	A.4.1
41	Mark	A.4	A.4.2
42	Anne	A.1	A.1.1
43	Anne	A.1	A.1.2
44	Anne	A.2	A.2.1																		500
45	Anne	A.2	A.2.2
46	Anne	A.3	A.3.1																	50
47	Anne	A.3	A.3.2
48	Anne	A.4	A.4.1
49	Anne	A.4	A.4.2																200
Database1

Database_2023_modified.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	Name	Activity	Sub-activity	Additional field 1	Additional field 2	Additional field 3	Additional field 4	Bgt 01/11/2022	Bgt 01/12/2022	Bgt 01/01/2023	Bgt 01/02/2023	Bgt 01/03/2023	Bgt 01/04/2023	Bgt 01/05/2023	Bgt 01/06/2023	11/22	12/22	01/23	02/23	03/23	04/23	05/23	06/23
2	John	A.1	A.1.1
3	John	A.1	A.1.2							1100
4	John	A.2	A.2.1
5	John	A.2	A.2.2
6	John	A.3	A.3.1
7	John	A.3	A.3.2
8	John	A.4	A.4.1
9	John	A.4	A.4.2
10	Mark	A.1	A.1.1
11	Mark	A.1	A.1.2						700
12	Mark	A.2	A.2.1
13	Mark	A.2	A.2.2								800
14	Mark	A.3	A.3.1
15	Mark	A.3	A.3.2
16	Mark	A.4	A.4.1
17	Mark	A.4	A.4.2
18	Anne	A.1	A.1.1
19	Anne	A.1	A.1.2
20	Anne	A.2	A.2.1										5000
21	Anne	A.2	A.2.2
22	Anne	A.3	A.3.1									525
23	Anne	A.3	A.3.2
24	Anne	A.4	A.4.1
25	Anne	A.4	A.4.2								1000
26	John	A.1	A.1.1
27	John	A.1	A.1.2															1000
28	John	A.2	A.2.1
29	John	A.2	A.2.2
30	John	A.3	A.3.1
31	John	A.3	A.3.2
32	John	A.4	A.4.1
33	John	A.4	A.4.2
34	Mark	A.1	A.1.1
35	Mark	A.1	A.1.2														650
36	Mark	A.2	A.2.1
37	Mark	A.2	A.2.2																750
38	Mark	A.3	A.3.1
39	Mark	A.3	A.3.2
40	Mark	A.4	A.4.1
41	Mark	A.4	A.4.2
42	Anne	A.1	A.1.1
43	Anne	A.1	A.1.2
44	Anne	A.2	A.2.1																		5000
45	Anne	A.2	A.2.2
46	Anne	A.3	A.3.1																	500
47	Anne	A.3	A.3.2
48	Anne	A.4	A.4.1
49	Anne	A.4	A.4.2																850
Database2

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("H:I")) Is Nothing Then Exit Sub
    Dim vDB As Variant, vDB1 As Variant, vDB2 As Variant, vDate1 As Variant, vDate2 As Variant
    Dim col As Long, lCol1 As Long, lcol2 As Long, v As Variant, i As Long, ii As Long, val1 As String, val2 As String
    Application.ScreenUpdating = False
    With Sheets("Database1")
        lCol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate1 = .Range("P1").Resize(, lCol1 - 15).Value
        vDB1 = .Range("A26", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    With Sheets("Database2")
        lcol2 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate2 = .Range("P1").Resize(, lcol2 - 15).Value
        vDB2 = .Range("A26", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    Select Case Target.Column
        Case Is = 8
            vDB = Range("B" & Target.Row).Resize(, 6).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate1
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 15
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 6)
            For ii = LBound(vDB1) To UBound(vDB1)
                val2 = vDB1(ii, 1) & "|" & vDB1(ii, 3)
                If val1 = val2 Then
                    Sheets("Database1").Cells(ii + 25, col) = Target.Value
                    Exit For
                End If
            Next ii
        Case Is = 9
            vDB = Range("B" & Target.Row).Resize(, 6).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate2
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 15
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 6)
            For ii = LBound(vDB2) To UBound(vDB2)
                val2 = vDB2(ii, 1) & "|" & vDB2(ii, 3)
                If val1 = val2 Then
                    Sheets("Database2").Cells(ii + 25, col) = Target.Value
                    Exit For
                End If
            Next ii
    End Select
    Application.ScreenUpdating = True
End Sub

 

[Atlantis764]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("H:I")) Is Nothing Then Exit Sub
    Dim vDB As Variant, vDB1 As Variant, vDB2 As Variant, vDate1 As Variant, vDate2 As Variant
    Dim col As Long, lCol1 As Long, lcol2 As Long, v As Variant, i As Long, ii As Long, val1 As String, val2 As String
    Application.ScreenUpdating = False
    With Sheets("Database1")
        lCol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate1 = .Range("P1").Resize(, lCol1 - 15).Value
        vDB1 = .Range("A26", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    With Sheets("Database2")
        lcol2 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate2 = .Range("P1").Resize(, lcol2 - 15).Value
        vDB2 = .Range("A26", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    Select Case Target.Column
        Case Is = 8
            vDB = Range("B" & Target.Row).Resize(, 6).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate1
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 15
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 6)
            For ii = LBound(vDB1) To UBound(vDB1)
                val2 = vDB1(ii, 1) & "|" & vDB1(ii, 3)
                If val1 = val2 Then
                    Sheets("Database1").Cells(ii + 25, col) = Target.Value
                    Exit For
                End If
            Next ii
        Case Is = 9
            vDB = Range("B" & Target.Row).Resize(, 6).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate2
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 15
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 6)
            For ii = LBound(vDB2) To UBound(vDB2)
                val2 = vDB2(ii, 1) & "|" & vDB2(ii, 3)
                If val1 = val2 Then
                    Sheets("Database2").Cells(ii + 25, col) = Target.Value
                    Exit For
                End If
            Next ii
    End Select
    Application.ScreenUpdating = True
End Sub

Hi Mumps,

Thank you again for all your help and support!
This VBA code also works great!
I will look at the VBA code sent by you and try to see what changes I will have to make in the future if I need to change the target range (I am sure that will have to add more rows and columns).

Best regards,
Liviu

 

[mumps]

You are very welcome.

 

[Atlantis764]

Hi again Mumps,

a new day and a new problem that I ran into and I can't solve it, again.
I modified the work file and the VBA code sent by you (as far as I could see, I modified it well according to the changes in the excel file-at least I hope I did it well).
I added in the Database a new column - column H "Net/Gross" where I would like to select if the values are for Net or Gross.
Consequently, this column was added to the other 2 worksheets (Database1 for hours and Database2 for amount). So now I have for each expert, in addition to activity and sub-activity, this division between net and gross.
I manually entered record no 8 in the Database and the amounts were added to the corresponding cells in Database1 and Database2 for the "Net" row (with yellow) - the amounts were 300 and 3000.
When I manually entered the next record (the same data, the only difference being gross instead of net), instead of putting the values in the blue cells (for the "Gross" row), it replaced the amounts from the previous record and put the values in the yellow cells.
Can you help me with a solution for this problem as well?

Many thanks!

Database_2023_15.03.2023.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	S.No.	Year	Month	Date	Name	Additional field 1	Additional field 2	Net/Gross	Activity	Sub-activity	Worked hours	Amount	User Name
2	1	2022	December	30-Dec-2022	John	aa	sss	Net	A.2	A.2.2	100	1000	Liviu Popescu	14/03/2023 15:56
3	2	2022	December	30-Dec-2022	John	ddd	fff	Gross	A.2	A.2.2	50	500	Liviu Popescu	14/03/2023 15:57
4	3	2023	January	31/01/2023	Anne	ddd	ttt	Gross	A.3	A.3.2	125	1250	Liviu Popescu	14/03/2023 16:05
5	4	2023	January	31-Jan-2023	Anne	ddff	gggg	Net	A.3	A.3.2	200	2000
6	5	2023	February	28-Feb-2023	Mark	ggg	hhh	Gross	A.4	A.4.2	150	1500	Liviu Popescu	15/03/2023 10:00
7	6	2023	February	28/02/2023	Mark	ss	frf	Net	A.4	A.4.2	78	780	Liviu Popescu	15/03/2023 10:02
8	7	2023	May	31-May-2023	Anne	fff	ddd	Net	A.2	A.2.1	150	1500	Liviu Popescu	15/03/2023 11:09
9	8	2023	April	30-Apr-2023	John	fff	ffffff	Net	A.4	A.4.1	300	3000
10	9	2023	April	30-Apr-2023	John	fff	ffffff	Gross	A.4	A.4.1	200	2000
Database

Database_2023_15.03.2023.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	Name	Activity	Sub-activity	Net/Gross	Additional field 1	Additional field 2	Additional field 4	Bgt 01/11/2022	Bgt 01/12/2022	Bgt 01/01/2023	Bgt 01/02/2023	Bgt 01/03/2023	Bgt 01/04/2023	Bgt 01/05/2023	Bgt 01/06/2023	11/22	12/22	01/23	02/23	03/23	04/23	05/23	06/23
2	John	A.1	A.1.1	Net
3	John	A.1	A.1.1	Gross
4	John	A.1	A.1.2	Net
5	John	A.1	A.1.2	Gross
6	John	A.2	A.2.1	Net
7	John	A.2	A.2.1	Gross
8	John	A.2	A.2.2	Net
9	John	A.2	A.2.2	Gross
10	John	A.3	A.3.1	Net
11	John	A.3	A.3.1	Gross
12	John	A.3	A.3.2	Net
13	John	A.3	A.3.2	Gross
14	John	A.4	A.4.1	Net
15	John	A.4	A.4.1	Gross
16	John	A.4	A.4.2	Net
17	John	A.4	A.4.2	Gross
18	Mark	A.1	A.1.1	Net
19	Mark	A.1	A.1.1	Gross
20	Mark	A.1	A.1.2	Net
21	Mark	A.1	A.1.2	Gross
22	Mark	A.2	A.2.1	Net
23	Mark	A.2	A.2.1	Gross
24	Mark	A.2	A.2.2	Net
25	Mark	A.2	A.2.2	Gross
26	Mark	A.3	A.3.1	Net
27	Mark	A.3	A.3.1	Gross
28	Mark	A.3	A.3.2	Net
29	Mark	A.3	A.3.2	Gross
30	Mark	A.4	A.4.1	Net
31	Mark	A.4	A.4.1	Gross
32	Mark	A.4	A.4.2	Net
33	Mark	A.4	A.4.2	Gross
34	Anne	A.1	A.1.1	Net
35	Anne	A.1	A.1.1	Gross
36	Anne	A.1	A.1.2	Net
37	Anne	A.1	A.1.2	Gross
38	Anne	A.2	A.2.1	Net
39	Anne	A.2	A.2.1	Gross
40	Anne	A.2	A.2.2	Net
41	Anne	A.2	A.2.2	Gross
42	Anne	A.3	A.3.1	Net
43	Anne	A.3	A.3.1	Gross
44	Anne	A.3	A.3.2	Net
45	Anne	A.3	A.3.2	Gross
46	Anne	A.4	A.4.1	Net
47	Anne	A.4	A.4.1	Gross
48	Anne	A.4	A.4.2	Net
49	Anne	A.4	A.4.2	Gross
50	John	A.1	A.1.1	Net
51	John	A.1	A.1.1	Gross
52	John	A.1	A.1.2	Net
53	John	A.1	A.1.2	Gross
54	John	A.2	A.2.1	Net
55	John	A.2	A.2.1	Gross
56	John	A.2	A.2.2	Net													100
57	John	A.2	A.2.2	Gross													50
58	John	A.3	A.3.1	Net
59	John	A.3	A.3.1	Gross
60	John	A.3	A.3.2	Net
61	John	A.3	A.3.2	Gross
62	John	A.4	A.4.1	Net																	200
63	John	A.4	A.4.1	Gross
64	John	A.4	A.4.2	Net
65	John	A.4	A.4.2	Gross
66	Mark	A.1	A.1.1	Net
67	Mark	A.1	A.1.1	Gross
68	Mark	A.1	A.1.2	Net
69	Mark	A.1	A.1.2	Gross
70	Mark	A.2	A.2.1	Net
71	Mark	A.2	A.2.1	Gross
72	Mark	A.2	A.2.2	Net
73	Mark	A.2	A.2.2	Gross
74	Mark	A.3	A.3.1	Net
75	Mark	A.3	A.3.1	Gross
76	Mark	A.3	A.3.2	Net
77	Mark	A.3	A.3.2	Gross
78	Mark	A.4	A.4.1	Net
79	Mark	A.4	A.4.1	Gross
80	Mark	A.4	A.4.2	Net															78
81	Mark	A.4	A.4.2	Gross															150
82	Anne	A.1	A.1.1	Net
83	Anne	A.1	A.1.1	Gross
84	Anne	A.1	A.1.2	Net
85	Anne	A.1	A.1.2	Gross
86	Anne	A.2	A.2.1	Net																		150
87	Anne	A.2	A.2.1	Gross
88	Anne	A.2	A.2.2	Net
89	Anne	A.2	A.2.2	Gross
90	Anne	A.3	A.3.1	Net
91	Anne	A.3	A.3.1	Gross
92	Anne	A.3	A.3.2	Net														200
93	Anne	A.3	A.3.2	Gross														125
94	Anne	A.4	A.4.1	Net
95	Anne	A.4	A.4.1	Gross
96	Anne	A.4	A.4.2	Net
97	Anne	A.4	A.4.2	Gross
Database1

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("K:L")) Is Nothing Then Exit Sub
    Dim vDB As Variant, vDB1 As Variant, vDB2 As Variant, vDate1 As Variant, vDate2 As Variant
    Dim col As Long, lCol1 As Long, lcol2 As Long, v As Variant, i As Long, ii As Long, val1 As String, val2 As String
    Application.ScreenUpdating = False
    With Sheets("Database1")
        lCol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate1 = .Range("P1").Resize(, lCol1 - 15).Value
        vDB1 = .Range("A50", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    With Sheets("Database2")
        lcol2 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate2 = .Range("P1").Resize(, lcol2 - 15).Value
        vDB2 = .Range("A50", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    Select Case Target.Column
        Case Is = 11
            vDB = Range("B" & Target.Row).Resize(, 9).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate1
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 15
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 9)
            For ii = LBound(vDB1) To UBound(vDB1)
                val2 = vDB1(ii, 1) & "|" & vDB1(ii, 3)
                If val1 = val2 Then
                    Sheets("Database1").Cells(ii + 49, col) = Target.Value
                    Exit For
                End If
            Next ii
        Case Is = 12
            vDB = Range("B" & Target.Row).Resize(, 9).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate2
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 15
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 9)
            For ii = LBound(vDB2) To UBound(vDB2)
                val2 = vDB2(ii, 1) & "|" & vDB2(ii, 3)
                If val1 = val2 Then
                    Sheets("Database2").Cells(ii + 49, col) = Target.Value
                    Exit For
                End If
            Next ii
    End Select
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("K:L")) Is Nothing Then Exit Sub
    Dim vDB As Variant, vDB1 As Variant, vDB2 As Variant, vDate1 As Variant, vDate2 As Variant
    Dim col As Long, lCol1 As Long, lcol2 As Long, v As Variant, i As Long, ii As Long, val1 As String, val2 As String
    Application.ScreenUpdating = False
    With Sheets("Database1")
        lCol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate1 = .Range("P1").Resize(, lCol1 - 15).Value
        vDB1 = .Range("A50", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 4).Value
    End With
    With Sheets("Database2")
        lcol2 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        vDate2 = .Range("P1").Resize(, lcol2 - 15).Value
        vDB2 = .Range("A50", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 4).Value
    End With
    Select Case Target.Column
        Case Is = 11
            vDB = Range("B" & Target.Row).Resize(, 9).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate1
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 15
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 7) & vDB(1, 9)
            For ii = LBound(vDB1) To UBound(vDB1)
                val2 = vDB1(ii, 1) & "|" & vDB1(ii, 4) & vDB1(ii, 3)
                If val1 = val2 Then
                    Sheets("Database1").Cells(ii + 49, col) = Target.Value
                    Exit For
                End If
            Next ii
        Case Is = 12
            vDB = Range("B" & Target.Row).Resize(, 9).Value
            val1 = vDB(1, 2) & "|" & vDB(1, 1)
            For Each v In vDate2
                i = i + 1
                val2 = MonthName(Month(CDate(v))) & "|" & Year(CDate(v))
                If val1 = val2 Then
                    col = i + 15
                    Exit For
                End If
            Next v
            val1 = vDB(1, 4) & "|" & vDB(1, 7) & vDB(1, 9)
            For ii = LBound(vDB2) To UBound(vDB2)
                val2 = vDB2(ii, 1) & "|" & vDB2(ii, 4) & vDB1(ii, 3)
                If val1 = val2 Then
                    Sheets("Database2").Cells(ii + 49, col) = Target.Value
                    Exit For
                End If
            Next ii
    End Select
    Application.ScreenUpdating = True
End Sub