Consolidate multiple Wkbs into ONE-update-then push back down updated data

[myexcellent123]

Hello! First of all, thank you in advance to anyone reading this!

So, here is my situation, I have a set list of Unique IDS and standard row of same, header columns across multiple workbooks. Alll of these are saved on a central Sharepoint webpage.

These wkbs are split between 3 depts. I have a total of about 275 columns and 1300 Unique IDs.

The first dept has split the Unique Ids and updates across all columns. Easy to merge and i have the macro that accomplishes this. Basically it opens all files and copies and adds one wkb beneath each other into one single sheet.

The second dept makes it complicated, as it has split COLUMNS (vs. Unique IDS) and multiple people are updating the same Unique ID but for different columns.

The third dept (single person) works on the comprehensive list of all Unique IDs but has his own section of columns.

So, the challenge is:

1.To merge all files across all dept into ONE MASTER WKB. I could do this in Access (linked via Unique ID) but it exceeds the 255 column limit, as this would go out to 275 columns.

.....then with all *updated* data off these files

2.To push all *updated* data back out to the individual files.

The attached sample Wkb might make this easier to understand. Please assume that each tab in this file is a separate workbook.

I truly appreciate any help on this!

 

[Smallman]

Hi Myexcellent123

The following should cover off the first part of your problem. Run from the Consolidation workbook.

Sub OpenImp()
    Const sPath = "C:\Test\" 'Change to suit
    Dim sFil As String
    Dim owb As Workbook
    Dim ws As Worksheet

    Set ws = Sheet1
    sFil = Dir(sPath & "*.xl*") '

    Do While sFil <> ""
        Set owb = Workbooks.Open(sPath & sFil)
        Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 275).Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
        owb.Close False 'Close no save
        sFil = Dir
    Loop
End Sub

You will need to change the file path and ensure the columns you are looking to resize is 275. Is there one sheet in the workbook being opened?

Now to push the data back into the workbooks, do you have a list of each of the workbooks somewhere in the workbook or are you intending to put that in the master sheet (somewhere on the page ie Col A, becomes workbook where the file came from. This makes the Export seamless.

Take care

Smallman

 

[myexcellent123]

Hi Smallman! Thank you so much!!! So currently I have a code that takes all files from Dept 1 (where they are split by Unique IDs and update across all columns). Where I get lost is the trying to consolidate all files from Dept 2 (where they update a single Unique ID but across multiple columns.

Does your code above, solve for that? will it take ALL data and consolidate? see- I am just very confused on the data from the Dept 2 files.

All of the files are on a Microsoft Sharepoint location. Even if I need to split into new workbooks and create a new workbooks for each individual file, thats ok.

This is my current code that consolidates and places each data range underneath one another:

Sub mainConsolidation()
With Excel.Application
  .ScreenUpdating = False
  .Calculation = Excel.xlCalculationManual
  .EnableEvents = False
End With
Dim a As Integer
Workbooks("CONSOLIDATE MASTER.xlsm").Worksheets("Sheet1").Range("A2:JP10000").ClearContents '
Call File2
Call File3
all Blank
With Excel.Application
  .ScreenUpdating = True
  .Calculation = Excel.xlAutomatic
  .EnableEvents = True
End With
End Sub
Sub blank()
Dim mr As Range
Dim ict As Long
Set mr = ActiveSheet.UsedRange
For ict = mr.Rows.Count To 1 Step -1
If Application.CountA(Rows(ict).EntireRow) = 0 Then
Rows(ict).Delete
End If
Next ict
End Sub
Sub File2()
Dim arange As String
Dim a As Integer
Dim cell As Object
Dim wb As Workbook
Application.DisplayStatusBar = True
Set wb = Workbooks.Open("Sharepoint /File2.xlsm")
Workbooks("File2.xlsm").Worksheets("Sheet1").Activate
ActiveSheet.Cells.EntireColumn.Hidden = False
ActiveSheet.Cells.EntireRow.Hidden = False
With ActiveSheet
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
End If
End With
a = Workbooks("CONSOLIDATE MASTER.xlsm").Worksheets("Sheet1").UsedRange.Rows.Count
Dim rc1 As Integer
rc1 = Workbooks("File2.xlsm").Worksheets("Sheet1").Range("A10000").End(xlUp).Row ' ptn column is A
Dim rc2 As Integer
rc2 = Workbooks("CONSOLIDATE MASTER.xlsm").Worksheets("Sheet1").Range("A:A").SpecialCells(xlLastCell).Row - 1
arange = "A2:JP" & rc1
Workbooks("File2.xlsm").Worksheets("Sheet1").Range(arange).Copy
Workbooks("CONSOLIDATE MASTER.xlsm").Worksheets("Sheet1").Range(arange).PasteSpecial Paste:=xlPasteValues
Workbooks("File2.xlsm").Close savechanges:=False
End Sub

 

[myexcellent123]

oh- all lines reference a wkb are on a microsoft sharepoint - i removed my exact link as for
anonymity

 

[Smallman]

Hi Me123

In short yes the code above (post 2) will bring all the data from multiple files and stack it on one sheet. The code you dropped above can be optimised. I am sitting in an airport right now so if some kind hearted person has not replied by tonight Aussie time, I will knock up a procedure for you.

Take Care

Smallman

 

[myexcellent123]

Thank you so much Smallman! Safe travels!