Automatically update one sheet from multiple other sheetsSolved/Closed

Question

Hello, 

I have a workbook with each office location having its own sheet to keep track of project information all with the same column headings. Column C is "Project Type" and I have created a drop down list with 4 types. Now I would like to create a master sheet for each of the 4 project types that would pull from all office locations and update automatically when new projects are added to any of the office location sheets. I would really appreciate help with the code!

System Configuration: Windows / Chrome 100.0.4896.127

vcoolio · Answer

Hello Zboneill,

To make this simpler to help you with a resolution, could you please upload a sample of your workbook to a file sharing site such as WeTransfer or Drop Box and then post the link to your file back here. Please ensure that your sample is an exact replica of your actual workbook in all aspects and if your data is sensitive, then please use dummy data. A few rows of data per sheet will suffice.

Cheerio,
vcoolio.

zboneill · Answer

Hi vcoolio,

Here's the link:

https://www.dropbox.com/scl/fi/co55qee8cwlwqmfrv5v4s/BD-Funnel-practice.xlsm?dl=0&rlkey=e8q29pn5fi5btv76dxztduaz6

I created new tabs for each of the project types where I'm looking for the information to populate automatically from the location tabs. The analysis and ops tabs are not relevant here so I deleted their data.
Thanks!

vcoolio · Answer

Hello Zboneill,

If I've followed your intent correctly, then I believe the following code will do the task for you:-

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Intersect(Target, Sh.Columns(3)) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    
    Dim ar As Variant, i As Long
    ar = Array("Construction Management", "Treatment", "Infrastructure", "Master Planning")
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False

For i = 0 To UBound(ar)
                  If Target.Value = ar(i) Then
                        Target.EntireRow.Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
                        Sheets(ar(i)).Columns.AutoFit
                  End If
            Next i
              
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

The code is a Workbook_SheetChange event code which will execute each time a selection is made from the drop downs in Column C of each source sheet with the relevant row of data being immediately transferred to it's relevant worksheet. No buttons are required.

To implement this code:-

- Right click on any sheet tab.
- Select "View Code" from the menu that appears.
- You should now be in the VB Editor. Over to the left, in the Project Explorer, double click on ThisWorkbook.
- To the right, in the big white code field, paste the above code.

Please test the above code in a copy of your workbook first.

Please ensure that the selection made in Column C is the last task per row.

I hope that this helps.

Cheerio,
vcoolio.

zboneill · Answer

That works great! Thank you! Now is there a way that if a row is edited/updated on one of the location tabs it could also be updated on the project type tab?

vcoolio · Answer

Hello Zboneill,

You could probably use one code to do two tasks if you like as follows:-

Sub Test()

Dim ar As Variant, arr As Variant, i As Long, x As Long
        Dim lr As Long, ws As Worksheet, wsAr As Worksheet
            
        ar = Array("Construction Management", "Treatment", "Infrastructure", "Master Planning")
        arr = Array("San Diego", "Ventura County", "OC_RS", "LA", "Fresno", "Central Coast", "Bakersfield")
    
Application.ScreenUpdating = False
     
        For i = 0 To UBound(ar)
                        Set wsAr = Sheets(ar(i))
                        wsAr.UsedRange.Offset(2).Clear
                For x = 0 To UBound(arr)
                        lr = Sheets(arr(x)).Range("A" & Rows.Count).End(xlUp).Row
                      With Sheets(arr(x)).Range("C3:C" & lr)
                            .AutoFilter 1, ar(i), 7
                            .Offset(1).EntireRow.Copy wsAr.Range("A" & Rows.Count).End(3)(2)
                            .AutoFilter
                      End With
                Next x
                      wsAr.Columns.AutoFit
                      wsAr.Rows.AutoFit
                      wsAr.UsedRange.WrapText = False
          Next i

Application.ScreenUpdating = True
    
End Sub

With this code, you will need to completely remove the previous one from the ThisWorkbook module. After you place this code into a standard module, you can assign it to a button on each location sheet or simply assign a short cut key to the code. It can be run from any worksheet, so I would recommend the short cut key rather than have a multitude of buttons.
This code will allow you to fill in data as required in each row of the location sheets and in no particular order. Once done, run the code and the data will be transferred to its relative project type sheet. This will immediately happen from all the location sheets to the project type sheets, all at once. If you need to edit or update any data in any location sheet, do so then run the code again. You'll note that each project type sheet will be refreshed with the data updates.

Please take note:
I've noticed that each location sheet has a lot of clutter directly below the data sets. This is not good sheet management and can interfere with any sub routines, formulae etc.. I have attached your sample workbook with the new code implemented and assigned to the short cut key Ctrl+Shift+Z (this will work on any sheet).

You'll note that in each location sheet in the sample that, for the sake of 'smooth sailing' and to avoid the clutter, I've created 'a current region' by inserting one blank row above the headings row and at least one blank row below the data set, generally just below the totals of Columns H:I. This will ensure that the code runs smoothly. Hence the code could as well be written as follows to reference the Current Region of each location sheet:-

Sub Test()

Dim ar As Variant, arr As Variant, i As Long, x As Long
        Dim lr As Long, ws As Worksheet, wsAr As Worksheet
            
        ar = Array("Construction Management", "Treatment", "Infrastructure", "Master Planning")
        arr = Array("San Diego", "Ventura County", "OC_RS", "LA", "Fresno", "Central Coast", "Bakersfield")
    
Application.ScreenUpdating = False
     
        For i = 0 To UBound(ar)
                        Set wsAr = Sheets(ar(i))
                        wsAr.UsedRange.Offset(2).Clear
                For x = 0 To UBound(arr)
                        lr = Sheets(arr(x)).Range("A" & Rows.Count).End(xlUp).Row
                      With Sheets(arr(x)).[A3].CurrentRegion
                            .AutoFilter 3, ar(i), 7
                            .Offset(1).EntireRow.Copy wsAr.Range("A" & Rows.Count).End(3)(2)
                            .AutoFilter
                      End With
                Next x
                      wsAr.Columns.AutoFit
                      wsAr.Rows.AutoFit
                      wsAr.UsedRange.WrapText = False
          Next i

Application.ScreenUpdating = True
    
End Sub

This should be more efficient as well. Here is the link to your sample file:-

https://wetransfer.com/downloads/eb02f22f1187d4fad2da71c1126e8be820220517123425/2000f6

I hope that this helps.

Cheerio,
vcoolio.

zboneill · Answer

This is working great! Thank you so much!

vcoolio · Answer

Hello Zboneill,

You're welcome. I'm glad to have been able to assist.

Cheerio,
vcoolio

Automatically update one sheet from multiple other sheets

7 responses

Subscribe To Our Newsletter!