Multiple sheet inventory management: Conditionally copy missing items to another sheet?

[Bandittheone]

Hello,

We currently use a Excel doc with about 50 sheets, each representing a different box that is shipped/loaned frequently and needs to be rechecked often to confirm it has it's full inventory. Line items(rows) are also often added/removed to each box. The desired amount of item X is always in the same column and the current "Fill" is directly beside it.

I'm looking for one sheet to display rows with only missing items from all 50 boxes.

For example:

Sheet 1
Box 1 Desired Qty Actual Qty
Item A 10 5
Item B 5 5
Item C 20 10

Sheet 2
Box 2 Desired Qty Actual Qty
Item A 15 5
Item G 50 46
Item H 200 200




Sheet 3
Desired Qty Actual Qty Missing Qty
Item A 25 10 15
Item C 20 10 10
Item G 50 46 4


The items in the boxes change frequently, with new ones being added monthly, so creating a database of all items is not the best solution.

Thanks!

 

[Bandittheone]

Bump. Thanks!

 

[Logit]

.
You will receive a better response if a copy of your existing workbook were posted for download / review. Do not include any confidential information.

creating a database of all items is not the best solution.

I believe that will create issues to obtain your goal.

 

[Robby19]

50 different pivot tables on 1 sheet filtered to only show items with a 0 value.

 

[vcoolio]

<b2,true,false)"
<b2,true,false)"
Hello Bandit,

If I've understood your request, then the following code may help:-

Sub Test()

     Dim ws As Worksheet
     Dim lr As Long, lr1 As Long
     
Application.ScreenUpdating = False
     
Sheet1.UsedRange.Offset(1).ClearContents

For Each ws In Worksheets
     If ws.Name <> "Sheet1" Then
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("D2:D" & lr) = "=if(C2 
With ws.[A1].CurrentRegion
             .AutoFilter 4, True
             .Offset(1).EntireRow.Copy
             Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
             .AutoFilter
             .Columns(4).ClearContents
             End With
       End If
Next ws

lr1 = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Sheet1.Range("D2:D" & lr1) = "=SUM(B2-C2)"

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The code will insert a formula in Column D of each sheet (except your main sheet - sheet1 in the code) to determine if the values in Column C are less than the values in Column B. The formula determines a TRUE or FALSE value for each row and the code will filter on TRUE then transfer the relevant rows of data from each sheet to the main sheet (Sheet1). The code then inserts a formula in Column D of the main sheet to determine the "missing" value.

Following is the link to a small sample I prepared for you so that you can see how the code works. Click on the "RUN" button to see it work.

http://ge.tt/1AsUEfp2

I hope that this helps.

Cheerio,
vcoolio.</b2,true,false)"
</b2,true,false)"

 

[Bandittheone]

Thank you very much vcoolio,

I opened the document you made and the module was completely missing, which could be due to our network security which may have stripped the code. I then copied your code into a new module and the debugger didn't like the underlined potion of the code:



For Each ws In Worksheets
If ws.Name <> "Sheet1" Then
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("D2:D" & lr) = "=if(C2 "
With ws.[A1].CurrentRegion
.AutoFilter 4, True
.Offset(1).EntireRow.Copy
Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
.AutoFilter
.Columns(4).ClearContents
End With
End If
Next ws


What do you think the issue is?

Thanks!

 

[vcoolio]

Hello Bandit,

That's probably an error on my side as I had a hell of a time with the seemingly simple task of adding code tags. With the first few attempts, only half the code appeared between the code tags then it finally appeared to work but I didn't check to see that all was OK.

So here it is again:-

Sub Test()

     Dim ws As Worksheet
     Dim lr As Long, lr1 As Long
     
Application.ScreenUpdating = False
     
Sheet1.UsedRange.Offset(1).ClearContents

For Each ws In Worksheets
     If ws.Name <> "Sheet1" Then
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("D2:D" & lr) = "=if(C2<B2,True,False)"

With ws.[A1].CurrentRegion
             .AutoFilter 4, True
             .Offset(1).EntireRow.Copy
             Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
             .AutoFilter
             .Columns(4).ClearContents
             End With
       End If
Next ws

lr1 = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Sheet1.Range("D2:D" & lr1) = "=SUM(B2-C2)"

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Test it in a copy of your work book. That link is still OK if you can access it.

Cheerio,
vcoolio.

 

[vcoolio]

...........nope. Still doesn't work. It won't even allow me to just type the line of code below!

I'll try later.

Hopefully a Moderator will see this a fix it!
<b2,true,false)"
<b2,true,false)"
<b2,true,false)"


Cheerio,
vcoolio.</b2,true,false)"
</b2,true,false)"
</b2,true,false)"

 

[Bandittheone]

Just tried it on my personal computer and the file does work, so I'm thinking it might be the security system on our work computers

Hopefully I will be able to find a work around.

Thanks a lot so far vcoolio. Let me know if you figure out the 2nd method.

 

[Bandittheone]

I just tried impementing your example with my inventory system and couldn't get too far. I'm just not too sure which parts need to change to reflect the different locations of my data.

Here is a link to a sample showing the style of inventory management we use:
https://1drv.ms/x/s!AizpA15wjAfHjcAZEFSWtEasj5ltvg

Please let me know if the link doesn't work.

Thanks!