Consolidate All tabs in one with Dynamic Rows/ colums

VbaNoExcel · Nov 7th 2017

Hello Good People

Just need a BIG help for a task. I have attached the Excel Sheet here.

I have multiple worksheets (Product1, Product 2, Product3 and new worksheets will be added as I add new products) and also have multiple sub categories (e.g. a Product has Multiple sub products and a Customer Group has multiple Sub Customer Groups which varies based on products, this will also extend/ change based on many/ few sub categories) .

I want to show all the tabs' information in one "Consolidated" tab where the rows and columns are dynamic based on Sub categories and number of rows.

If in the "Product" tab, any "Sub Product" or "Sub Customer" category is blank…then for the "Consolidated" tab, it should be filled by the previous category's description like those highlighted in green in the "Manual_Consolidated" tab.

I have done the "Manual_Consolidated" tab to show you guys what i want to accomplish in the "Macros_Consolidated" tab.

I hope i do not sound too confusing....happy to clarify again if needed.

Many thanks in advance for your kind help.

VbaNoExcel · Nov 8th 2017

Hello folks, I was wondering if it is possible to help at all....

VbaNoExcel · Nov 16th 2017

just writing again to check if this can be solved with kind help from you guys......

nilem · Nov 17th 2017

On all sheets are always 3 Sub_Product_Groups, and 3 Customer_SubGroups, right?

jolivanes · Nov 17th 2017

You could try this

Code

Sub AAAAA()
Dim sh1 As Worksheet, i As Long, ColArr, j As Long, c As Range, lr As Long


ColArr = Array(4, 7, 8)
Set sh1 = Worksheets("Consolidated")


Sheets("Product1").Range("A1:H1").Copy sh1.Range("A1")


For i = 3 To ThisWorkbook.Sheets.Count   '<--- Change 3 to the sheet from where you start (probably 2)
    Sheets(i).UsedRange.Offset(2).Copy sh1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next i


lr = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row


For j = LBound(ColArr) To UBound(ColArr)
    With sh1
        For Each c In .Range(.Cells(1, ColArr(j)), .Cells(lr, ColArr(j)))
            If Len(c) < 1 Then c.Value = c.Offset(, -1).Value
        Next c
    End With
Next j


End Sub

Display More

VbaNoExcel · Nov 17th 2017

Quote from nilem

On all sheets are always 3 Sub_Product_Groups, and 3 Customer_SubGroups, right?

Hi Milem
The number of products and Subproducts will go up or down based on each Salesperson's Sales target. For example, One Excel file may have 10 products and 20 subproducts...this means, l like to have dynamic columns and rows for each tab so that i can use it universally for everyone.

VbaNoExcel · Nov 17th 2017

hi JOLIVANES

many thanks. let me try and i will come back if i stumble upon anything. just wondering if the codes also take care fo flexibility for rows and columns. I mean, i might add more rows and columns or have less rows and columns depending on situation. will this hadle that as well? sorry for not being clear in the first time.

Quote from jolivanes

You could try this

Code

Sub AAAAA()
Dim sh1 As Worksheet, i As Long, ColArr, j As Long, c As Range, lr As Long


ColArr = Array(4, 7, 8)
Set sh1 = Worksheets("Consolidated")


Sheets("Product1").Range("A1:H1").Copy sh1.Range("A1")


For i = 3 To ThisWorkbook.Sheets.Count '<--- Change 3 to the sheet from where you start (probably 2)
Sheets(i).UsedRange.Offset(2).Copy sh1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next i


lr = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row


For j = LBound(ColArr) To UBound(ColArr)
With sh1
For Each c In .Range(.Cells(1, ColArr(j)), .Cells(lr, ColArr(j)))
If Len(c) < 1 Then c.Value = c.Offset(, -1).Value
Next c
End With
Next j


End Sub

Display More

VbaNoExcel · Nov 17th 2017

hi JOLIVANES

It is working!!!!!!!!!!!!!!!!!!! many thanks, bro!!!!!!!!!!!!!!!!!!!! u rock and hats off to you.....I will come back and ask you for help again in case it stops working when i change the number of rows and columns.

Quote from jolivanes

You could try this

Code

Sub AAAAA()
Dim sh1 As Worksheet, i As Long, ColArr, j As Long, c As Range, lr As Long


ColArr = Array(4, 7, 8)
Set sh1 = Worksheets("Consolidated")


Sheets("Product1").Range("A1:H1").Copy sh1.Range("A1")


For i = 3 To ThisWorkbook.Sheets.Count '<--- Change 3 to the sheet from where you start (probably 2)
Sheets(i).UsedRange.Offset(2).Copy sh1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next i


lr = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row


For j = LBound(ColArr) To UBound(ColArr)
With sh1
For Each c In .Range(.Cells(1, ColArr(j)), .Cells(lr, ColArr(j)))
If Len(c) < 1 Then c.Value = c.Offset(, -1).Value
Next c
End With
Next j


End Sub

Display More

jolivanes · Nov 18th 2017

Used Range is not really the most robust way of doing things but in absence of more info, it will have to do for now.
Yes, if you want to check it out, add another bunch of columns and/or rows and run it (maybe on a copy)
If you change this

Code

Sheets(i).UsedRange.Offset(2).Copy sh1.Cells(Rows.Count, 1).End(xlUp).Offset(1)

to this

Code

Sheets(i).UsedRange.Offset(2).Copy sh1.Cells(sh1.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row, 1).Offset(1)

then you'll be OK in case some columns are longer than others.

And you can change this

Code

For j = LBound(ColArr) To UBound(ColArr)
    With sh1
        For Each c In .Range(.Cells(1, ColArr(j)), .Cells(lr, ColArr(j)))
            If Len(c) < 1 Then c.Value = c.Offset(, -1).Value
        Next c
    End With
Next j

to this

Code

For j = LBound(ColArr) To UBound(ColArr)
    With sh1
        For Each c In .Range(.Cells(1, ColArr(j)), .Cells(lr, ColArr(j))).SpecialCells(4)
            c.Value = c.Offset(, -1).Value
        Next c
    End With
Next j

It has less cells to loop through.

Consolidate All tabs in one with Dynamic Rows/ colums

Participate now!

Share