Macro to automatically update a master sheet from multiple sheets Solved/Closed

Question

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

TrowaD · Answer

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

monu · Answer

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!

TrowaD · Answer

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

monu · Answer

This is what I anticipated. You are amazing. It 's working. Thanks a ton for all the help.

Monu · Answer

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?

TrowaD · Answer

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

monu · Answer

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.

TrowaD · Answer

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

monu · Answer

I just can't express how amazing you are. The code works exactly the way I wanted. Thank you so much!

monu · Answer

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?

TrowaD · Answer

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

monu · Answer

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

Monu · Answer

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!!

Macro to automatically update a master sheet from multiple sheets

13 responses

Similar discussions

Subscribe To Our Newsletter!