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

 

[Atlantis764]

Hi Mumps,

the VBA code sent by you works great!
You saved me al lot of time and effort!
Thanks again!

Best regards,
Liviu

 

[mumps]

You are very welcome.