Multiple Workbooks Merging into 1 Spreadsheet

[NFIREPROTECTION]

Good Morning All,

My company is working on upgrading their system for tracking their change orders. We have it currently being tracked on paper and then input into a spreadsheet.


We need all the data that goes into the tabs RS, DW, and GM TO automatically input into the Sheet1 spreadsheet with no spaces between the lines of data.
Is this possible? Is there a way to do it? or Is there an easier way to make this happen?

Any Info you can give would be greatly appreciated!

 

[Fishboy]

Good Morning All,

My company is working on upgrading their system for tracking their change orders. We have it currently being tracked on paper and then input into a spreadsheet.


We need all the data that goes into the tabs RS, DW, and GM TO automatically input into the Sheet1 spreadsheet with no spaces between the lines of data.
Is this possible? Is there a way to do it? or Is there an easier way to make this happen?

Any Info you can give would be greatly appreciated!

Hi NFIREPROTECTION, welcome to the boards.

Just to clarify, you want to merge the data from 3 separate sheets into a 4th consolidated sheet? Are these sheets all within the same workbook or in multiple workbooks as the thread title suggests? If they are in separate workbooks then you will need to let us know the names of each of the workbooks.

Also, how do you envision the end result looking? Are there column headers on each sheet? Do these need to be copied as well? Are there the same number of columns on each sheet?

 

[NFIREPROTECTION]

Yes, that is correct. I am looking to merge the 3 separate sheets into a 4th consolidated sheet. I apologize for my lack of description, all of the spreadsheets are under the same workbook named Change Log 1.

1st Tab = RS
2nd Tab = DW
3rd Tab = GM

Headers for these are:
Estimator / Designer / Project / Date Received / Date Response Required / Description


4th Consolidated Tab = Sheet1

Headers for this is:
Job Number / Estimator / Local / Project / Description / Date Sent / CO # / Status / CO Approved / CO Amount / Notes

As of now i will only need the Estimator, Project and Description to transfer over to the 4th tab.

I am unable to attach the spreadsheet to this thread for a better understanding, but I was able to throw it in our company dropbox with the link below if needed.

https://www.dropbox.com/s/6pcfgk9m3ft6ktt/CHANGE LOG 1.xlsx?dl=0

Once again, thank you for taking the time to look at this.

 

[Fishboy]

OK, so on the understanding that you delete the random junk values from column A of the RS sheet (there are some rows below the "last row" that have some null value formulas in them), and delete the random junk values just below the "last row" of Sheet1, then I believe the following macro should do what you need:

Sub MergeSheets()
Dim ws As Worksheet, wsLR As Long, OutputLR As Long, OldOutputLR As Long


OldOutputLR = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row + 1


For Each ws In Sheets(Array("RS", "DW", "GM"))
    wsLR = ws.Cells(Rows.Count, "A").End(xlUp).Row
    OutputLR = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row + 1
    ws.Range("A2:A" & wsLR).Copy Sheets("Sheet1").Range("B" & OutputLR)
    ws.Range("B2:B" & wsLR).Copy Sheets("Sheet1").Range("D" & OutputLR)
    ws.Range("E2:E" & wsLR).Copy Sheets("Sheet1").Range("E" & OutputLR)
Next ws


OutputLR = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("Sheet1").Range("A" & OldOutputLR, "K" & OutputLR).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
End Sub

 

[Comfy]

What version of Excel are you running?

 

[NFIREPROTECTION]

FISHBOY

Thank you for the help! That Macro worked out fantastically. Is it possible for the consolidated sheet to update and fill in as the other sheets are added to? Basically as each estimator gets a change order he will add more to his spreadsheet, as he updates we need that data to automatically transfer over to the 4th consolidated spreadsheet.


COMFY

I am running 2016 Excel and the other users running 2013 Excel. Hopefully that will not cause much of an issue

 

[Fishboy]

FISHBOY

Thank you for the help! That Macro worked out fantastically. Is it possible for the consolidated sheet to update and fill in as the other sheets are added to? Basically as each estimator gets a change order he will add more to his spreadsheet, as he updates we need that data to automatically transfer over to the 4th consolidated spreadsheet.

Happy to help.

Do you mean that each time a new line is added that line is transferred automatically? if so then that is quite plausible, but it would involve adding a Worksheet_Change event macro to the back end of each of the RS, DW and GM sheets. If you can clarify if this is what you meant then we can get to work on the code. Also, if this is the case, I assume it is fine that each new entry will just go to the bottom of the Sheet1 sheet and the order of the Estimators is not important?

 

[Comfy]

You could use Power Query to merge all three sheets into a separate workbook.

You could then refresh the connection automatically.

 

[NFIREPROTECTION]

Happy to help.


Do you mean that each time a new line is added that line is transferred automatically? if so then that is quite plausible, but it would involve adding a Worksheet_Change event macro to the back end of each of the RS, DW and GM sheets. If you can clarify if this is what you meant then we can get to work on the code. Also, if this is the case, I assume it is fine that each new entry will just go to the bottom of the Sheet1 sheet and the order of the Estimators is not important?

Yes, that is exactly what I am needing. The RS, DW, and GM sheets are updated daily and that data needs to be transfered over to the Main sheet as it is put in. Yes, if each entry goes to the bottom that would work for us perfect.
Thank you for the inquires and ideas

You could use Power Query to merge all three sheets into a separate workbook.


You could then refresh the connection automatically.

I am trying to understand and test the Power Query to merge the sheets, but I am afraid I do not know much about this.
Could you help me understand the process and how to make it work the way you are suggesting?
Thank you for the inquires and ideas

 

[Fishboy]

Yes, that is exactly what I am needing. The RS, DW, and GM sheets are updated daily and that data needs to be transfered over to the Main sheet as it is put in. Yes, if each entry goes to the bottom that would work for us perfect.
Thank you for the inquires and ideas

OK, so try out the following steps in a COPY of your workbook.

1. Make sure that you have run my original code from yesterday to initially populate Sheet1.

2. Copy and paste this code into any standard module within your workbook in the VBA Developer window:

Sub PlaceBorders()
Dim LastRow2 As Long


LastRow2 = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row


Set Rng = Sheets("Sheet1").Range("A" & LastRow2, "K" & LastRow2)
        With Rng.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Rng.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Rng.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Rng.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Rng.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Rng.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
End Sub

3. Once you have that in place then for each sheet (RS, DW and GM) right-click on their tab name in the main workbook and select View Code. In the new window that opens just copy and paste the following code into each of them:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long, LastRow2 As Long, Rng As Range


If Target.Cells.Count > 1 Then Exit Sub


LastRow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row


If Not Intersect(Target, Range("E2:E" & LastRow)) Is Nothing And Target.Value <> "" Then
    If Application.WorksheetFunction.CountIf(Range("A" & Target.Row, "E" & Target.Row), "<>") = 5 Then
        LastRow2 = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row + 1
        Range("A" & LastRow, "E" & LastRow).Copy
        Range("A" & Target.Row).Copy Sheets("Sheet1").Range("B" & LastRow2)
        Range("B" & Target.Row).Copy Sheets("Sheet1").Range("D" & LastRow2)
        Range("E" & Target.Row).Copy Sheets("Sheet1").Range("E" & LastRow2)
        Call PlaceBorders
        MsgBox "Sheet1 Updated"
    Else
        MsgBox "There is missing data on the row you have just updated"
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
End If


End Sub

The above codes will check as you update one of the 3 sheet. If you are updating column E of the first blank row on any of those sheets it checks to make sure you have completed the rest of the range A:E of that row and gives the user an error message, otherwise if range A:E of that row is complete then it copies the data over to the next row of Sheet1, then calls the PlaceBorders macro to draw the borders around the new entry on Sheet1. The same Worksheet_Change can be inserted into each worksheet module without needing to be amended.

Test it out and let me know how you get on.