Finding like data in multiple worksheets

[jaywebb846]

Hi I have a workbook we use for prep and production at the Lobos Stadium here in New Mexico and the workbook has about 12 worksheets that are associated with the stands we have that call production(requisition product). There are like products on several of the worksheets and I am using a standard naming convention on all products to make it easier for master production sheet. What I need to do is find all like products in all stands and then sum those quantities and copy them onto a master sheet. For example there may be BBQ pulled pork in 8 of the 12 stands and they all want 5 pans of pork, the unit of measure is the same for all stands on this product. So I need to have a macro that on button click will search all sheets for pork and then sum that quantity and copy pork 5 pans onto the master sheet. Then repeat looking for all other like items and do the same thing and continue this process on down the line on all sheets until a master production sheet is achieved. I assume I will need some sort of array to store the data for the sum procedure but I am very new at excel. Currently I just have a formula in each cell on my master that just sums the same cells and is mapped to the master sheet and that is fine until something changes in one or more sheets then I have to go back through and change all my sheets and formulas to correct the issue after adding or removing a production item.. I hope this is clear enough of an explanation and I hope someone can help me with this as we are starting a new season with all new menus which means all new production and several days of fixing formulas to get mapping correct again..

Thanks

Jay

 

[jaywebb846]

So, trying to simplify all that, is each one of these correct? Please clarify if any one is incorrect.

1. You only want the code to bring across 'Item', 'Location', 'Unit of Measure' and (Total) 'Quantity'?
2. Those values should go into columns A:D of 'Master Production', starting at row 3?
3. The code doesn't need to clear out any old data from 'Master Production' in columns A:D from row 3 down?

Hi Peter
Yes that is all correct. THank you so much for your help

 

[Peter_SSs]

Yes that is all correct.

In that case try

Sub Get_Quantities_v3()
  Dim d As Object
  Dim ws As Worksheet
  Dim r As Long
  Dim s As String
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  For Each ws In Worksheets
    If ws.Name <> "Master Production" Then
      With ws
        For r = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
          If LCase(.Cells(r, 2).Value) = "*******" Then
            s = Join(Application.Index(.Cells(r, 1).Resize(, 3).Value, 1, 0), ",")
            d(s) = d(s) + .Cells(r, 4).Value
          End If
        Next r
      End With
    End If
  Next ws
  Application.ScreenUpdating = False
  With Sheets("Master Production").Range("A3:D3").Resize(d.Count)
    With .Columns(1)
      .Value = Application.Transpose(Array(d.Keys))
      .TextToColumns DataType:=xlDelimited, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False
    End With
    .Columns(4).Value = Application.Transpose(Array(d.Items))
    .EntireColumn.AutoFit
  End With
  Application.ScreenUpdating = True
End Sub

 

[jaywebb846]

In that case try

Sub Get_Quantities_v3()
  Dim d As Object
  Dim ws As Worksheet
  Dim r As Long
  Dim s As String
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  For Each ws In Worksheets
    If ws.Name <> "Master Production" Then
      With ws
        For r = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
          If LCase(.Cells(r, 2).Value) = "*******" Then
            s = Join(Application.Index(.Cells(r, 1).Resize(, 3).Value, 1, 0), ",")
            d(s) = d(s) + .Cells(r, 4).Value
          End If
        Next r
      End With
    End If
  Next ws
  Application.ScreenUpdating = False
  With Sheets("Master Production").Range("A3:D3").Resize(d.Count)
    With .Columns(1)
      .Value = Application.Transpose(Array(d.Keys))
      .TextToColumns DataType:=xlDelimited, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False
    End With
    .Columns(4).Value = Application.Transpose(Array(d.Items))
    .EntireColumn.AutoFit
  End With
  Application.ScreenUpdating = True
End Sub

Yes that works perfect..thank you.. Can you bring across the Unit Cost column as well(column E). that is all that is missing and it is perfection.

 

[Peter_SSs]

1. You only want the code to bring across 'Item', 'Location', 'Unit of Measure' and (Total) 'Quantity'?

Yes that is all correct.

Hmm, seems like that last answer wasn't quite right then.

Can you bring across the Unit Cost column as well(column E). that is all that is missing and it is perfection.

Go back to the _v2 code and just remove the line near the end of the code that puts a formula in .Columns(6)


BTW, best not to fully quote long posts as it makes the thread harder to read/navigate. If you want to quote, quote small, relevant parts only.

 

[jaywebb846]

Hmm, seems like that last answer wasn't quite right then.

Go back to the _v2 code and just remove the line near the end of the code that puts a formula in .Columns(6).

Hi Peter

Yes you are correct I was not thorough enough when I made that statement..
The last version seems to work the best. Version 2 has some unexpected results it brings over duplicate data. The last version you sent brings all the data correctly with no duplications the only issue is the Unit Cost field. I removed the formula from version 2 as stated however the duplicate data is an issue. Is there a way to just modify the last version to include that Unit Cost Column? I really like how it keeps all data grouped together properly and again has no duplicates. I tried to figure out how it was getting data to modify it but I just don't seem to get it quite right.

I really appreciate it

 

[jaywebb846]

Hey Peter

I figured it out.. It was an issue on my end.. had different prices on unit cost which caused duplicate data. It works perfectly now.. Sorry for the confusion and indecision on my part.

THank you for all your help.. it is awesome and will make the new season here even smoother.

 

[Peter_SSs]

Glad it is working for you now.