Consulting

Results 1 to 3 of 3

Thread: Consolidating excel files with different rows and columns?

  1. #1
    VBAX Newbie
    Joined
    Jan 2012
    Posts
    2
    Location

    Smile Consolidating excel files with different rows and columns?

    Hi,

    I'm new to this forum. Just started working as a research analyst for a media company and we work with huge spreadsheets pretty often. I'm looking into learning VBA in free time, but I have a question off the bat. Here's my dilemma:

    I have 3 excel files, each of them with multiple worksheets. Within a file, each worksheet has identical rows, but different columns. Across all 3 files, the rows and columns are different. In the data field, there are numbers and blanks (representing zeros). So-- is it possible to consolidate all this information into one excel file, while summing up fields with an identical row and column?

    I've attached an example of what I'm trying to do. I think it will help to visualize what I'm trying to do.

    Any help of advice is much appreciated. Thanks!
    Attached Files Attached Files

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Welcome to VBAX
    Give this a try
    [VBA]Sub GetData()
    Dim Sht As Worksheet
    Dim Bk As Workbook
    Dim arr()
    Dim Col1 As New Collection
    Dim Row1 As New Collection
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim Pth As String
    Dim Site As Range, s As Range
    Dim Co As Range, c As Range


    Set Bk = Workbooks.Add
    Set Sht = ActiveSheet
    Pth = "C:\AAA\"

    'Get all Fields and Companies
    arr = Array("Book1") ',"Book2","Book3")
    For Each a In arr
    Set wb = Workbooks.Open(Pth & a & ".xlsx")
    For Each sh In wb.Worksheets
    Set Site = sh.Columns(1).SpecialCells(xlCellTypeConstants)
    Set Co = sh.Rows(1).SpecialCells(xlCellTypeConstants)
    On Error Resume Next

    For Each s In Site
    If Not s = "" Then Col1.Add CStr(s), CStr(s)
    Next
    For Each c In Co
    If Not c = "" Then Row1.Add CStr(c), CStr(c)
    Next
    Next
    Next
    wb.Close False

    For i = 1 To Col1.Count
    Sht.Cells(i, 1) = Col1(i)
    Next

    For i = 1 To Row1.Count
    Sht.Cells(1, i) = Row1(i)
    Next


    'Get all numbers
    For Each a In arr
    Set wb = Workbooks.Open(Pth & a & ".xlsx")
    For Each sh In wb.Worksheets
    For i = 2 To Row1.Count
    'Look up companies
    Set c = sh.Rows(1).Find(Sht.Cells(1, i), lookat:=xlWhole)
    If Not c Is Nothing Then col = c.Column
    For j = 2 To Col1.Count
    'Look up sites
    Set r = sh.Columns(1).Find(Sht.Cells(j, 1), lookat:=xlWhole)
    If Not r Is Nothing Then rw = r.Row
    'Read data and add to grid
    If Not (r Is Nothing Or c Is Nothing) Then
    Sht.Cells(j, i) = Sht.Cells(j, i) + sh.Cells(rw, col)
    End If
    Next
    Next

    Next
    wb.Close False
    Next
    End Sub[/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    VBAX Newbie
    Joined
    Jan 2012
    Posts
    2
    Location
    Hi mdmackillop,

    Thanks for the reply! Sorry for the newbie questions, but how do I get this script to run, and does it apply to all currently open excel files?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •