Macro to automatically update a master sheet from multiple sheets

Solved
Monu - Nov 30, 2021 at 11:51 AM
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 - Aug 16, 2022 at 11:38 AM
Hello,

I have a file with a master sheet and 6 different individual sheets. Each sheet is considered a project. It includes person's information and the amount of work completed by that person for that particular project. Whenever someone adds new rows to the other project sheets, it also has to be added to the master sheet. The master file includes individual names in column A (no duplicates) and project names in 6 other columns. Each project represents each individual sheet. A person might work for more than one project. I added xlookup formula to the master sheet, so that whenever I enter a new person to the individual project sheet as well to the master, all the data is auto-populated based on the formula. All I need is a macro that I can autopopulate all the columns related to that individual when new rows/persons are added to the sheets. Can anyone please help?
System Configuration: Windows / Edge 95.0.1020.44
Related:

13 replies

Thank you so much Trowa! The code seems to work exactly the way I wanted. I have never seen such an amazing talent. Thank you for all that you do to help people with their queries.
Happy new year!!
1
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523
Dec 13, 2021 at 11:12 AM
Hi Monu,

Could you provide some sample data? You can add screenshots in your post or use a free filesharing site (always be careful with sensitive data) and post back the download link.

Best regards,
Trowa
0
Hi Trowa, Thanks for your response. Please find the link to sample file.

https://docs.google.com/spreadsheets/d/1nyaosY0f-E_jih0aDUOyWzDiyP6A-FxG/edit?usp=sharing&ouid=112008101437851899047&rtpof=true&sd=true

Whenever I do a new entry in any of the project sheets, it should automatically be added to the master "personnel list & effort".

Thank you!
0
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523
Dec 14, 2021 at 12:25 PM
Hi Monu,

Check out the code below.
  • It will add a new Name from a project sheet to the master sheet if it does not exist.
  • When you enter the org, it will find the Name it is placed next to on the master sheet and add it as well.
  • Lastly the formula from the row above is autofilled 1 row down.


Here is the code that needs to be placed in EACH of the Project sheets:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mFind As Range
If Target.Cells.Count > 1 Then Exit Sub

With Sheets("Personnel list & effort ")

    If Not Intersect(Target, Columns("A")) Is Nothing Then
        Set mFind = .Columns("A").Find(Target.Value)
        If mFind Is Nothing Then
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Target.Value
        End If
    End If
    
    If Not Intersect(Target, Columns("B")) Is Nothing Then
        Set mFind = .Columns("A").Find(Target.Offset(0, -1).Value)
        mFind.Offset(0, 1).Value = Target.Value
        .Select
        .Range(.Cells(mFind.Row - 1, "C"), .Cells(mFind.Row - 1, "E")).AutoFill Destination:=.Range(.Cells(mFind.Row - 1, "C"), .Cells(mFind.Row, "E"))
    End If
End With
End Sub


Is this how you envisioned it?

Best regards,
Trowa

0
Hi TrowaD,
One more quick request.
1. I am trying to update an existing value within one of the project sheets but it isn't reflecting in the master. Instead, it is added as a new row and existing one remains the same in master.
2. Also, when I delete a row in a project sheet, it should reflect that change in the master sheet. In other words, it should work as a refresh of the project sheets.
Can you please help?
0

Didn't find the answer you are looking for?

Ask a question
This is what I anticipated. You are amazing. It 's working. Thanks a ton for all the help.
0
Hi TrowaD,
One more quick request.
1. I am trying to update an existing value within one of the project sheets but it isn't reflecting in the master. Instead, it is added as a new row and existing one remains the same in master.
2. Also, when I delete a row in a project sheet, it should reflect that change in the master sheet. In other words, it should work as a refresh of the project sheets.
Can you please help?
0
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523
Dec 16, 2021 at 12:14 PM
Hi Monu,

Good to see we are on the right track.

1. It's working for column A now. I ran into a little trouble trying to do it for column B as well since. Column B does not contain unique values, so it makes it a bit more challenging.
2. When you want to delete the corresponding row on the master sheet, delete the value in column A of a project sheet first, before deleting the rest of the data.

Here is the code:
Dim aVal As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mFind As Range
If Target.Cells.Count > 1 Then Exit Sub

With Sheets("Personnel list & effort ")
    If aVal = vbNullString Then
        If Not Intersect(Target, Columns("A")) Is Nothing Then
            Set mFind = .Columns("A").Find(Target.Value)
            If mFind Is Nothing Then
                .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Target.Value
            End If
        End If
        
        If Not Intersect(Target, Columns("B")) Is Nothing Then
            Set mFind = .Columns("A").Find(Target.Offset(0, -1).Value)
            mFind.Offset(0, 1).Value = Target.Value
            .Select
            .Range(.Cells(mFind.Row - 1, "C"), .Cells(mFind.Row - 1, "E")).AutoFill Destination:=.Range(.Cells(mFind.Row - 1, "C"), .Cells(mFind.Row, "E"))
        End If
    Else
        If Target.Value <> vbNullString Then
            If Not Intersect(Target, Columns("A")) Is Nothing Then
                Set mFind = .Columns("A").Find(aVal)
                If mFind Is Nothing Then
                    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Target.Value
                Else
                    mFind.Value = Target.Value
                End If
            End If
        Else
            If Not Intersect(Target, Columns("A")) Is Nothing Then
                Set mFind = .Columns("A").Find(aVal)
                .Rows(mFind.Row).Delete
            End If
        End If
    End If
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns("A")) Is Nothing Then
    aVal = Target.Value
End If
End Sub


Best regards,
Trowa

0
Hi Trowa,
On deletion of any row from the project sheet, it's getting deleted in the master sheet but let say if the same name (column A) exists in 2 different sheets and if we delete the name in one sheet, since the name still exists in the other project sheet, the master sheet shouldn't delete that name. But, unfortunately with the above code, if we delete the name from one sheet and if the same name exists in other sheet, it is getting deleted in the master sheet. If the name exists atleast in any one of the project sheets, it should remain in the master. Can you please modify the code if possible? Thank you for all the help again.
0
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523
Dec 20, 2021 at 12:21 PM
Hi Monu,

Ok, master row will only get deleted when the value can't be found on the other project sheet.
In addition, changing a value in column A will not only update the master sheet, but also checks if the value needs to be changed on the other project sheets as well.
The same goes for column B values.

Pay attention to the green text in the beginning of the code, as you will need to change the sheet names of the other project sheet names. This code is for the sheet Project1. So the other 2 sheet names are "Project2" and "Project3". When you paste the code in sheet Project2, you will need to change the 2 into a 1 so it reads: "Project1" and "Project3".

Here is the code:
Dim aVal As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mFind As Range
Dim keepRow As Boolean
Dim pSheetA, pSheetB As String
'This is the code for the sheet "Project1", below you will find the names of the other 2 project sheets.
'These are necessary to make changes in those sheets. Make sure you change them, when you use the code for the other 2 project sheets.
pSheetA = "Project2"
pSheetB = "Project3"

If Target.Cells.Count > 1 Then Exit Sub

With Sheets("Personnel list & effort ")
    If aVal = vbNullString Then
        If Not Intersect(Target, Columns("A")) Is Nothing Then
            Set mFind = .Columns("A").Find(Target.Value)
            If mFind Is Nothing Then
                .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Target.Value
            End If
        End If
        
        If Not Intersect(Target, Columns("B")) Is Nothing Then
            Set mFind = .Columns("A").Find(Target.Offset(0, -1).Value)
            mFind.Offset(0, 1).Value = Target.Value
            .Select
            If mFind.Row > 2 Then
                .Range(.Cells(mFind.Row - 1, "C"), .Cells(mFind.Row - 1, "E")).AutoFill Destination:=.Range(.Cells(mFind.Row - 1, "C"), .Cells(mFind.Row, "E"))
            ElseIf mFind.Row = 2 Then
                .Range(.Cells(mFind.Row + 1, "C"), .Cells(mFind.Row + 1, "E")).AutoFill Destination:=.Range(.Cells(mFind.Row + 1, "C"), .Cells(mFind.Row, "E"))
            End If
            Set mFind = Sheets(pSheetA).Columns("A").Find(Target.Offset(0, -1).Value)
            If Not mFind Is Nothing Then mFind.Offset(0, 1).Value = Target.Value
            Set mFind = Sheets(pSheetB).Columns("A").Find(Target.Offset(0, -1).Value)
            If Not mFind Is Nothing Then mFind.Offset(0, 1).Value = Target.Value
        End If
    Else
        If Target.Value <> vbNullString Then
            If Not Intersect(Target, Columns("A")) Is Nothing Then
                Set mFind = .Columns("A").Find(aVal)
                If mFind Is Nothing Then
                    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Target.Value
                Else
                    mFind.Value = Target.Value
                    Set mFind = Sheets(pSheetA).Columns("A").Find(aVal)
                    If Not mFind Is Nothing Then mFind.Value = Target.Value
                    Set mFind = Sheets(pSheetB).Columns("A").Find(aVal)
                    If Not mFind Is Nothing Then mFind.Value = Target.Value
                End If
            End If
        Else
            If Not Intersect(Target, Columns("A")) Is Nothing Then
                Set mFind = Sheets(pSheetA).Columns("A").Find(aVal)
                If Not mFind Is Nothing Then keepRow = True
                Set mFind = Sheets(pSheetB).Columns("A").Find(aVal)
                If Not mFind Is Nothing Then keepRow = True
                If keepRow = False Then
                    Set mFind = .Columns("A").Find(aVal)
                    .Rows(mFind.Row).Delete
                End If
                keepRow = False
            End If
        End If
    End If
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns("A")) Is Nothing Then aVal = Target.Value
End Sub


Best regards,
Trowa
0
naaaaaaaaaaaa
Jul 19, 2022 at 02:33 AM

how to run the code. its opening the dialogue box for the macro name. pl help.

0
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523 > naaaaaaaaaaaa
Updated on Aug 16, 2022 at 11:41 AM

Hi Naaaaaaaaaaaa,

This is a code which runs automaically when a change is made to the worksheet the code is applied to. You can see this by checking out code line 2: worksheet change.

Best regards,

Trowa

0
I just can't express how amazing you are. The code works exactly the way I wanted. Thank you so much!
0
Hi Trowa,
The code worked perfectly fine on project sheets 1 and 2 but when I tried to apply the same code to project 3 (with code changed so it reads project 1 and 2), it keeps throwing an unexpected error (screen continuously blinks, ends abruptly, closes the workbook). Am I doing something wrong?
Also, if I wanted to added 6 more project sheets to the workbook, how should the code be edited?
0
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523
Dec 21, 2021 at 12:09 PM
Hi Monu,

Add the following line between code line 11 and 13:
Application.EnableEvents = False

Add the following line between code line 69 and 70:
Application.EnableEvents = True

That should prevent the error.


To add more project sheets, you have to add to the sheets on code lines 5, 8 and 9.
Code line 5 to declare the variables.
Add to code line 8 and 9 to add more sheet names.

Then in the code there 3 places where these variables are used:
Code lines 31 to 34, 44 to 47, 52 to 55. Here you will need to copy 2 lines per sheet and adjust the sheet variable.

That should do it.

Best regards,
Trowa
0
Is this the code Trowa? The code doesn't do anything after insertion. Am I doing something wrong? I inserted the 2 lines on all the project sheets.

Dim aVal As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mFind As Range
Dim keepRow As Boolean
Dim pSheetA, pSheetB As String
'This is the code for the sheet "Project1", below you will find the names of the other 2 project sheets.
'These are necessary to make changes in those sheets. Make sure you change them, when you use the code for the other 2 project sheets.
pSheetA = "Project2"
pSheetB = "Project3"

If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Sheets("Personnel list & effort ")
If aVal = vbNullString Then
If Not Intersect(Target, Columns("A")) Is Nothing Then
Set mFind = .Columns("A").Find(Target.Value)
If mFind Is Nothing Then
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Target.Value
End If
End If

If Not Intersect(Target, Columns("B")) Is Nothing Then
Set mFind = .Columns("A").Find(Target.Offset(0, -1).Value)
mFind.Offset(0, 1).Value = Target.Value
.Select
If mFind.Row > 2 Then
.Range(.Cells(mFind.Row - 1, "C"), .Cells(mFind.Row - 1, "E")).AutoFill Destination:=.Range(.Cells(mFind.Row - 1, "C"), .Cells(mFind.Row, "E"))
ElseIf mFind.Row = 2 Then
.Range(.Cells(mFind.Row + 1, "C"), .Cells(mFind.Row + 1, "E")).AutoFill Destination:=.Range(.Cells(mFind.Row + 1, "C"), .Cells(mFind.Row, "E"))
End If
Set mFind = Sheets(pSheetA).Columns("A").Find(Target.Offset(0, -1).Value)
If Not mFind Is Nothing Then mFind.Offset(0, 1).Value = Target.Value
Set mFind = Sheets(pSheetB).Columns("A").Find(Target.Offset(0, -1).Value)
If Not mFind Is Nothing Then mFind.Offset(0, 1).Value = Target.Value
End If
Else
If Target.Value <> vbNullString Then
If Not Intersect(Target, Columns("A")) Is Nothing Then
Set mFind = .Columns("A").Find(aVal)
If mFind Is Nothing Then
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Target.Value
Else
mFind.Value = Target.Value
Set mFind = Sheets(pSheetA).Columns("A").Find(aVal)
If Not mFind Is Nothing Then mFind.Value = Target.Value
Set mFind = Sheets(pSheetB).Columns("A").Find(aVal)
If Not mFind Is Nothing Then mFind.Value = Target.Value
End If
End If
Else
If Not Intersect(Target, Columns("A")) Is Nothing Then
Set mFind = Sheets(pSheetA).Columns("A").Find(aVal)
If Not mFind Is Nothing Then keepRow = True
Set mFind = Sheets(pSheetB).Columns("A").Find(aVal)
If Not mFind Is Nothing Then keepRow = True
If keepRow = False Then
Set mFind = .Columns("A").Find(aVal)
.Rows(mFind.Row).Delete
End If
keepRow = False
End If
End If
End If
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns("A")) Is Nothing Then aVal = Target.Value
Application.EnableEvents = True
End Sub
0
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen September 12, 2022 523
Dec 23, 2021 at 11:43 AM
Hi Monu,

My bad, the line:
Application.EnableEvents = True

should be between code lines 64 and 65 and NOT between 69 and 70.

In case nothing is happing after the adjustment, you will have to manually re-enable events. This is done with the following code (put in a standard module and run code: top menu of the VBA window > Insert > Module > Paste code > F5 > double-click ReEnableEvents):
Sub ReEnableEvents()
Application.EnableEvents = True
End Sub

To be clear, this code only needs to be run once and can be deleted after.

For further assistance you will have to wait till next year.

Best wishes and a happy new year!
Trowa
0