Macro to Combine Data

According to your attachment a variation of the same way you already have in your previous threads as a beginner starter
to paste only to the Sheet3 (Consolidate) worksheet class module :

PHP Code: 

Sub Demo1()
    Dim L&, oDic As Object, S&, V, R&
        L = 1
        UsedRange.Clear
        Set oDic = CreateObject("Scripting.Dictionary"):  oDic.CompareMode = 1
        Application.ScreenUpdating = False
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
    For S = Sheets("BR1 Cat").Index To Index - 1
        V = Sheets(S).[A1].CurrentRegion
        Cells(L, 1).Resize(UBound(V), 3) = V
        L = L + UBound(V)
    For R = 1 To UBound(V)
        .Item(V(R, 1)) = .Item(V(R, 1)) + V(R, 2)
         oDic(V(R, 3)) = oDic(V(R, 3)) + V(R, 2)
    Next R, S
        [A1].CurrentRegion.RemoveDuplicates 1
        [B1].Resize(.Count) = Application.Transpose(.Items)
       .RemoveAll
    End With
        [I1:J1].Resize(oDic.Count) = Application.Transpose(Array(oDic.Keys, oDic.Items))
        Application.ScreenUpdating = True
        oDic.RemoveAll:   Set oDic = Nothing
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

Thanks for the help.


I get a run time error -Object required and the code below is highlighted

Please Login or Register  to view this content.

No issue on my side with your attachment, works as expected …

Thanks Beyond Excel. Your code works 100%

Hi Marc


I have attached the workbook with your code and have tried on my Laptop and I still get a run time error


Please test & correct

You felt into the bad reader trap ‼ So just delete the useless Module1 and
as plain text explained in post #2 paste the VBA demonstration where it must be : into the worksheet module …

Hi Marc


I have amended your code ad Object required no longer appears

Please Login or Register  to view this content.

I have a another example to copy data from sheets F and I BR1 to the last sheet by copying the data in Cols A to J up to the last row containing data in Col A on these sheets and to combine the data and paste into sheet "Consolidated"

I have tried to amend the orignal code, but cannot get the code to work

Kindly test & amend

Originally Posted by Howardc1001

Your instruction was simple and clear

Thanks ! No problemo, I'll be back !

Thanks Marc. Look forward to your updated Code

I have Data in Cols A:J on sheets BR1 F and I Data to the last sheet


I need to combine the values In Col E where the descriptions In Col B are the same as well as combining the values in Col J where the descriptions in Col I are the same and paste these in the same cols as on these sheets on sheet consolidated


I have manually added the values to show the result on workbook "Consolidated Sales Manual Calc.xlsm"


Kindly test and provide me with code to combine the values

As the worksheets order is not the same than your initial post attachment so you must fit the worksheets loop accordingly …

So is your real workbook e x a c t l y like your previous post attachment or is it 'cause of post #5 ?!

Hi Marc

It must be as per post # 15

The data worksheets have always the same number of rows in the same order ?

As a reminder : poor explanation & attachment, poor code …

The number of rows will vary as this is sample data. The Account numbers in Col A will be in numerical order

Thanks for the help -Beyond Excel

Your code is perfect.

Please explain significance of code below

Please Login or Register  to view this content.

According to your post #15 attachment an Excel / VBA basics demonstration to paste to the Sheet3 (Consolidate) worksheet module :

PHP Code: 

Sub Demo2()
    Dim S&, R&, V, T#(), L&
        UsedRange.Clear
    With Application
        .ScreenUpdating = False
    For S = 2 To Sheets.Count
        With Sheets(S).UsedRange
            .Columns("A:B").Copy Cells(R + 1, 1)
             R = R + .Rows.Count
        End With
    Next
        Range("A1:B" & R).RemoveDuplicates 1
        V = [A1].CurrentRegion.Columns(1)
        ReDim T(1 To UBound(V), 0)
    With New Collection
            For R = 1 To UBound(V):  .Add R, CStr(V(R, 1)):  Next
        For S = 2 To Sheets.Count
        For R = 1 To Sheets(S).UsedRange.Rows.Count
            L = .Item(Sheets(S).Cells(R, 1).Text)
            T(L, 0) = T(L, 0) + Sheets(S).Cells(R, 5)
        Next R, S
    End With
        [E1].Resize(UBound(T)) = T
        [I1:J1] = Array(Sheets(2).[I1], .Sum(T))
        .ScreenUpdating = True
    End With
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

Many Thanks Marc.

I have tested your code and it works perfectly

Should there be values in Col C & D do I amend this part of your code :

Please Login or Register  to view this content.

to

Thanks for the explanation

Originally Posted by Howardc1001

Should there be values in Col C & D

Maybe yes, maybe no : no clue as - again - it depends on the exact layout and the exact expected result !
Proceeding like you do just means you have the Excel / VBA skills to fit yourself any code any helper can share
but when it's not the case, that's just a non sense, a waste of time …

Anyway, thanks for the rep' !