Trying to consolidate Workbooks with Same WorkSheet Names

[LisaUK]

Hi Everyone,

New to the board and hoping that someone can help with consolidating from different workbooks which have the same worksheet names

What I have are two workbooks which hold sales information for different companies.
Each workbook has Worksheets which are named the same e.g

Workbook1 has Worksheet named Sales Oct09 , Sales Nov 09
Workbook 2 has the same workseet names as above

I have tried to comsolidate data and it works to some degree.

But what My desired result needs to be is as follows


I need a new worksheet which combines data from both workbook1 and workbook2, but I need the worksheet name which reflects the month to be a column

Workbook data currently looks like this for both workbook1 and 2


Company Name Total Sales
ABC 32000
XYZ 56000


I have the same company names on both workbooks and hence trying to consolidate the data.

Desired result needs to be as foolows


Company Name Sales Oct 09 Sales Nov09
ABC total from all Workbooks total from all Workbooks
XYZ total from all Workbooks total from all Workbooks


I hope this makes sense, any help would be greatly appreciated. I am using excel 2007 and 2010.

Thank you
Lisa

 

[LisaUK]

Hi again all,

Any one any ideas on this at all?

Thanks
Lisa

 

[MickG]

Try this :-
Results in Active sheet.:- Start "A1"
NBB:- Change Wkb.name/ext/sheet.names in code Accordingly

[COLOR=navy]Sub[/COLOR] MG05Jun24
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] oSht [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] oBk [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] oBk [COLOR=navy]In[/COLOR] Array("Workbook(1).xls", "Workbook(2).xls")
        [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] oSht [COLOR=navy]In[/COLOR] Array("Sales Oct09", "Sales Nov09")
            [COLOR=navy]With[/COLOR] Workbooks(oBk).Sheets(oSht)
                [COLOR=navy]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & rows.Count).End(xlUp))
            [COLOR=navy]End[/COLOR] With
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
        .Add Dn.value, Dn(, 2)
    [COLOR=navy]Else[/COLOR]
        [COLOR=navy]If[/COLOR] Dn.row <> 1 [COLOR=navy]Then[/COLOR]
            .Item(Dn.value) = .Item(Dn.value) + Dn(, 2)
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Next[/COLOR] oSht
 [COLOR=navy]Next[/COLOR] oBk
Range("A1").Resize(.Count, 2) = Application.Transpose(Array(.keys, .Items))
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[LisaUK]

Hi Mick,

Thank you for the help really appreciate. I am already using the below as a solution

http://msdn.microsoft.com/en-us/library/cc793964.aspx

So far seems to be working ok, will try your solution as well to see what the difference is.

Thank you again

Lisa

 

[MickG]

My original code was incorrect as it placed "Oct" and "Nov" in same column The code below gives each month a seperate column.

[COLOR="Navy"]Sub[/COLOR] MG06Jun25
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] oSht [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oBk [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Twn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q
ReDim ray(1 To rows.Count, 1 To 4)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] oBk [COLOR="Navy"]In[/COLOR] Array("Workbook (1).xls", "Workbook (2).xls")
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] oSht [COLOR="Navy"]In[/COLOR] Array("Sales Oct09", "Sales Nov09")
            [COLOR="Navy"]With[/COLOR] Workbooks(oBk).Sheets(oSht)
                [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & rows.Count).End(xlUp))
            [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] oSht = "Sales Oct09" [COLOR="Navy"]Then[/COLOR]
            n = n + 1
            ray(n, 1) = Dn.value: ray(n, 2) = Dn(, 2)
        [COLOR="Navy"]Else[/COLOR]
            c = c + 1
            ray(c, 3) = Dn.value: ray(c, 4) = Dn(, 2)
        [COLOR="Navy"]End[/COLOR] If
        .Add Dn.value, Array(n, c)
    [COLOR="Navy"]Else[/COLOR]
     Q = .Item(Dn.value)
         [COLOR="Navy"]If[/COLOR] oSht = "Sales Oct09" [COLOR="Navy"]Then[/COLOR]
            ray(Q(0), 2) = ray(Q(0), 2) + Dn(, 2)
         [COLOR="Navy"]Else[/COLOR]
            ray(Q(1), 4) = ray(Q(1), 4) + Dn(, 2)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] oSht
[COLOR="Navy"]Next[/COLOR] oBk
Range("A2").Resize(.Count, 4) = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[LisaUK]

Hi Mick

Thank you for the update , will be trying this out

Regards
Lisa