Macro to extract values from all sheets after matching the Sheetname and Item Number

[prkhan56]

Thanks a lot

[mikeTRON]

So instead of creating a report with a macro, why not just aggregate the data to one DATAtab then use a pivtot table to create the report for you, so you dont have to check EACH sheet if it has a new Item concatenation etc etc.
That is how I solved issues like this when I am presented them.
Otherwise you write a ton of code to essentially replace the PivotTable functionality, where it already works great.

[prkhan56]

Hello Mike,
Thanks for your suggestion but the data is individually entered daily on different sheets every day and it is some work to get all the data under one Data Tab and create a pivot table.

For this reason I wanted a macro to do it for me. So I can run the code and see the report on any given day.

Hope to get some help

[prkhan56]

Hello Everyone,
Any help on this please

Thanks

[mikeTRON]

Hello Mike,
Thanks for your suggestion but the data is individually entered daily on different sheets every day and it is some work to get all the data under one Data Tab and create a pivot table.

For this reason I wanted a macro to do it for me. So I can run the code and see the report on any given day.

Hope to get some help

I would still have a data-tab to aggregate the data instead of a macro to just create the report.

[AB33]

I do not think many viewers understood your request.

A" want a macro which should fill in numbers from Column L on all Sheets after matching the Sheetname and ItemNo."

You have not shown on a sample where is column L in all sheets.

[prkhan56]

Hello ABB
I have attached a new sample
I have just shown till Sheet7 for explanation

Thanks for your time

Rashid

[AB33]

The code works on the sample provided. If you change the layout and format of the data, I need to change the code too.

[prkhan56]

Hello AB33,
Thanks for your code but it is not giving the right results as per my OP
I mentioned in my OP that the Item Nos may or may not be in sorted order
I have run your macro and I am attaching the results on a sample data where I have changed the Item No on Sheet3 and colored it for explanation sake.

The code is running only till 3 rows. Please see the Summary sheet after running the code.
Also see that the Item No and the values are not matching (See Sheet3 colored cells)

Kindly amend the code accordingly and also would you please exclude Sheet1 and Sheet2 from your code


Thanks for your time and help
Rashid

[AB33]

Yes, it would not have given the correct result. I was misread your question of ItemNo. meant to be serial number which is column A, not Description.

"would you please exclude Sheet1 and Sheet2 from your code?"
Right now, the code includes all sheets, but can easily change once you are happy with the result.


On your out put sample sheet, item nos on sheet are not on the right order. Try the attached.

[prkhan56]

Hello AB33,

Great code. You are a real Guru.

Can you fix 2 things for me please?
1) It should exclude Sheet1 and Sheet2
2) It should put 0 (zero) on Summary Sheet instead of leaving blanks where the Item Nos are not found on Sheets.

The code now shows a blank against any Item No which was not found

Hope to get your help and Thanks a million in advance.

Rashid

[jindon]

This should do.

Sub test()
    Dim ws As Worksheet, a, i As Long, ii As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    For Each ws In Worksheets
        If Not ws.Name Like "Summary*" Then
            a = ws.[a5].CurrentRegion.Value
            For i = 3 To UBound(a, 1)
                If Not dic.exists(a(i, 3)) Then
                    Set dic(a(i, 3)) = CreateObject("Scripting.Dictionary")
                    dic(a(i, 3)).CompareMode = 1
                End If
                dic(a(i, 3))(ws.Name) = VBA.Array(a(i, 2), a(i, 4), a(i, 12))
            Next
        End If
    Next
    With Sheets("summary").[a5].CurrentRegion
        With .Offset(3)
            Union(.Columns("b"), .Columns("d").Resize(, .Columns.Count - 3)).ClearContents
        End With
        a = .Value
        For i = 3 To UBound(a, 1)
            If dic.exists(a(i, 3)) Then
                For ii = 5 To UBound(a, 2)
                    If dic(a(i, 3)).exists(a(1, ii)) Then
                        a(i, 2) = dic(a(i, 3))(a(1, ii))(0)
                        a(i, 4) = dic(a(i, 3))(a(1, ii))(1)
                        a(i, ii) = dic(a(i, 3))(a(1, ii))(2)
                    End If
                Next
            End If
        Next
        .Value = a
    End With
End Sub

[AB33]

Try the attached

[prkhan56]

Thanks a lot.
Code is perfect.
Thread marked as SOLVED.

@Jindon - Thanks for your solution too.