Solved: update inventory when receiving and shipping

[mperrah]

I have an inventory update with an input screen
the equipment goes to a parts sheet or a receiver sheet

I then need to allocate the equipment out to techs

I'd like to set up a drop down (dv) on an invoice that pulls from the onhand quantities.
then printing the invoice adds to a running total of transactions (history)
Not sure where to start for removing equipment from inventory.

I will scan a barcode so the items will be unique coming in and going out.

I'll post what I have shortly

[mperrah]

here is the file so far.
I have the input for parts and receiving,
I have the invoice layout,
working on the functionality for picking what parts and receivers go on the invoice and then get deducted from inventory.
I plan to scan a barcode that will do a vlookup for the receivers in stock.
How do I remove the receiver data row from the reciever sheet on printing the invoice?

[mperrah]

I've built this inventory processor that allows for inputing new items
"Parts" and "Receivers"
Each item type has its' own inventory sheet.
As a tech takes items out, I generate an invoice.
The invoice can be printed. Then the data gets archived to a "recon" sheet. This logs all the items leaving the inventory.

What I need help with, is during the "recon" update, I need to deduct the items quantities from inventory sheets.

I have the code working to add quantities to incoming parts and receivers.
but not sure how to isolate each item to subtract quantities when they leave.
The number of parts do not change often (currently 34 item list) just the quantities go up and down.

The receivers are tracked by 4 numbers. they have barcodes we scan in on receipt and add them to inventory. We don't have to pay for them unless we can't install them within 30 days. I have warnings set for this.
Also there are only 4 model types. every receiver is unique though (serial numbers)

I have attached what I've done so far.
I was very proud on the recon sheet to get the new entry to line up right.
I got a lot of help from previous posts.

Thank you for being here.

If you can add code to the recon update to deduct each item as it updates would be great, this is where I need the help.
Or point me in a direction on how to manage the steps.

Thanks in advance, I'll keep scanning archives in the meantime...

[YellowLabPro]

I would think a Vlookup could handle this done at the point when added to the invoice sheet.

[Charlize]

I would use the first three characters of your stockitem ... ie. 01) through 34). For every line on your invoice look for those in column A of your partssheet. When found, deduct the value from column D of your invoice sheet from the value in column C of your partssheet. That will give you the result of the item still in stock.

On making the invoice, you could check the maximum allowed items that can be delivered. If you choose your stockitem, let a msgbox tell you how many items you still have in stock. If you want, you can even work with after deliveries ... or just deliver what's in stock.

Now about the updating of those partssheet. All those buttons drive me nuts (could be me, but pushing three buttons for accomplishing a task is dangerous. If I forget to push the recon button, no items are copied (so the partssheet cannot be updated even if I think about pushing the button to process the recon sheet --- deducting the values of the stockitems on recon sheet from those on the partssheet---). Than I have another button to process that recon sheet to adapt the partssheet. And I have to push a button to view the invoice.

I would put everything in the print invoice button. You could even use two call statements. The print button takes care of the call to the recon button, the call to process the recon sheet and prints the invoice and clears the invoice for a new one (and don't forget to clear the recon sheet).

What do you think ...

[YellowLabPro]

Here you go:
The only thing I have not figured out is how to isolate better the potential error 1004.
It is handled by the ubiquitous On Error Resume Next.
But I would prefer to Isolate it to 1004 only. I will post up separately to find a good way to handle this.


Sub UpdateInv()
Dim wsInvoice As Worksheet, wsParts As Worksheet, wsReceivers As Worksheet, Recon As Worksheet
Dim i As Long, lrowInv As Long, lrowPart As Long
Dim errornumber As Long
Set wsInvoice = Worksheets("Invoice")
Set wsParts = Worksheets("Parts")
lrowInv = wsInvoice.Cells(Rows.Count, 1).End(xlUp).Row
lrowPart = wsParts.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lrowInv
On Error Resume Next
Err.Clear
wsParts.Cells(i, 3).Value = wsParts.Cells(i, 3) - _
WorksheetFunction.VLookup(wsParts.Cells(i, 1), wsInvoice.Range("B6:D" & lrowInv), 3, 0)
Next i
End Sub

[YellowLabPro]

Change the last code to this. This handles the inevitable 1004 error and keeps the program from hiding any other errors that might arise you will not want to not know about.


Sub UpdateInv()
Dim wsInvoice As Worksheet, wsParts As Worksheet, wsReceivers As Worksheet, Recon As Worksheet
Dim i As Long, lrowInv As Long, lrowPart As Long
Dim errornumber As Long
Set wsInvoice = Worksheets("Invoice")
Set wsParts = Worksheets("Parts")
lrowInv = wsInvoice.Cells(Rows.Count, 1).End(xlUp).Row
lrowPart = wsParts.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lrowInv
On Error Resume Next
If Error.Number = 1004 Then
Err.Clear
Else
MsgBox "There is an Error, find and fix"
Exit Sub
End If
wsParts.Cells(i, 3).Value = wsParts.Cells(i, 3) - _
WorksheetFunction.VLookup(wsParts.Cells(i, 1), wsInvoice.Range("B6:D" & lrowInv), 3, 0)
Next i
End Sub

[Charlize]

This one uses your recon sheet for the parts. Not sure what to do with the receivers thing. Could you also clarify the meaning of column G and H on your parts sheet. I don't see what you want to do with it.Sub deduct_from_partssheet()
'recon sheet
Dim rng As Range
'parts sheet
Dim rng2 As Range
'cell on recon sheet I
Dim cell As Range
'cell on parts sheet A
Dim cell2 As Range
Dim sh_start As Worksheet
Dim sh_parts As Worksheet
Set sh_start = Worksheets("recon")
Set sh_dest = Worksheets("Parts")
Set rng = sh_start.Range("I2:I" & sh_start.Range("I" & Rows.Count).End(xlUp).Row)
Set rng2 = sh_dest.Range("A1:A" & sh_dest.Range("A" & Rows.Count).End(xlUp).Row)
For Each cell In rng
For Each cell2 In rng2
If Left(cell.Text, 3) = Left(cell2.Text, 3) Then
cell2.Offset(0, 2).Value = _
cell2.Offset(0, 2).Value - cell.Offset(, 2).Value
Exit For
End If
Next cell2
Next cell
'remove everything on recon sheet since it has been processed
'and has been deducted from partssheet
'sh_start.Cells.Clear
End Sub

[YellowLabPro]

Charliez,
I don't know if your method is any better, but I like what you did. Also, I think your advice on the multiple button scenario is plausible.

[Charlize]

If you like to use the builtin functions instead of another kind of way, then you use your way. If it's working, who cares (since there are not that many lines - 20). But I tried yours to, just to see ...

There are a couple of things I don't get.
- wsParts.Cells(i, 3).Value is the value of column A on parts
(but there are 34 parts and not 25 --- actually from row 6 to 25 is the invoice ---)
- I think you need to look up the value of the invoice in column B, starting from row 6 and look for a match at the parts sheet from A1 to C34
- When you found a match, deduct the 2 offset column of the invoice from the 3d column where a match was found

Well, that's what I think at least ...

[YellowLabPro]

If you like to use the builtin functions instead of another kind of way, then you use your way. If it's working, who cares ...
I agree, they both work. I was asking if there was a difference.
I thought it nice to see how you approached/solved from a different angle, so I was remarking about that. I had not thought about doing a match like you did. I will remember that for future use.


There are a couple of things I don't get.
- wsParts.Cells(i, 3).Value is the value of column A on parts
(but there are 34 parts and not 25 --- actually from row 6 to 25 is the invoice ---)...
Good Point, error on my part. It should have been
For i = 1 to lrowParts, ............ not lrowInv

Here is the corrected code:

Sub UpdateInv()
Dim wsInvoice As Worksheet, wsParts As Worksheet, wsReceivers As Worksheet, Recon As Worksheet
Dim i As Long, lrowInv As Long, lrowParts As Long
Dim errornumber As Long
Set wsInvoice = Worksheets("Invoice")
Set wsParts = Worksheets("Parts")
lrowInv = wsInvoice.Cells(Rows.Count, 1).End(xlUp).Row
lrowParts = wsParts.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lrowParts
On Error Resume Next
If Error.Number = 1004 Then
Err.Clear
Else
MsgBox "There is an Error, find and fix"
Exit Sub
End If
wsParts.Cells(i, 3).Value = wsParts.Cells(i, 3) - _
WorksheetFunction.VLookup(wsParts.Cells(i, 1), wsInvoice.Range("B6:D" & lrowInv), 3, 0)
Next i
End Sub


I need to run back through your code, step through to see exactly. Originally I thought the OP needed to have the qty updated on the Parts sheet and that was all. My code has no interaction w/ the "recon" sheet. Yours interacts w/ the "recon" sheet.
So I need to watch what happens differently between the two.

.
.
.

[YellowLabPro]

mperrah-
I have added the code where it belongs w/ two call statements, 1 at the Print Invoice and the other at the Recon button.

BTW: If you prefer Charliez, just sub in his procedure at the two call statements.....

[mperrah]

Charlize,
The H and G columns are for a dynamic data validation list on the invoice sheet.
The idea was to not have a line for every part always on the invoice.
but to allow a drop down to choose just the needed parts, but also as an item is chosen once, it is then removed from the data validation list as an available choice for subsequent lines. Basically only one occurence allowed for any chosen item. (If birdog is picked once, it cant be picked again, you just add to the quantity for the first time picked if more are needed.
Mark

[mperrah]

I would use the first three characters of your stockitem ... ie. 01) through 34). For every line on your invoice look for those in column A of your partssheet. When found, deduct the value from column D of your invoice sheet from the value in column C of your partssheet. That will give you the result of the item still in stock.
I like the first 3 letters of the item to search by, I was attempting that already and you madit make more sense, however I was trying to avoid every item staying on the invoice, only wanted items with quantities.


On making the invoice, you could check the maximum allowed items that can be delivered. If you choose your stockitem, let a msgbox tell you how many items you still have in stock. If you want, you can even work with after deliveries ... or just deliver what's in stock.
I was trying to make the validation list on the invoice show a number to the right of each item in the drop down that says the quantity on hand. I made this work on a different project and was planning to incorporate this idea here.



Now about the updating of those partssheet. All those buttons drive me nuts (could be me, but pushing three buttons for accomplishing a task is dangerous. If I forget to push the recon button, no items are copied (so the partssheet cannot be updated even if I think about pushing the button to process the recon sheet --- deducting the values of the stockitems on recon sheet from those on the partssheet---). Than I have another button to process that recon sheet to adapt the partssheet. And I have to push a button to view the invoice.

I too am not a huge fan of buttons, I have menu maker sheet I was considering incorporating, was waiting till all the subs are solidified.
One thing, on occasion the invoice may need to be printed without deducting from inventory (just as a copy or a price check...)
so having all the subs fire on printing didn't really fit. Some of the steps could be combined though... updating recon and clearing the invoice makes sense.


I would put everything in the print invoice button. You could even use two call statements. The print button takes care of the call to the recon button, the call to process the recon sheet and prints the invoice and clears the invoice for a new one (and don't forget to clear the recon sheet).

I like where this is going, maybe we can call a msg/input box on preparing to print that could have check boxes to ask on print if the users wants the invoice reset after, ask how many copies desired, ask to update recon on print (if price check, update not desired)...

What do you think ...
Thank you for soo many ideas.
I'll make some mods based on your suggestions and resubmit.
Thank you so much,
Mark

[mperrah]

The recon sheet is just a log that copies line for line the invoice.
This keeps track of everything leaving inventory.
Subtracting from this page I think would be more difficult to code then capturing the invoice data while updating the recon.

I had a challange getting the rows populated correctly on the recon.
Just counting a single column didnt work because sometimes there are more receivers than parts ordered and sometimes more parts than receivers. Thats why I made a test to see wich column is greater and use that for the new line.
Another problem was looping through copying the invoice, if I continually used the same last row the data piled up in the same row.
So i used the add i starting at zero then incremented each pass.
I am married and my wife was asleep but I partied like it was 1999 when the rows populated correctly...
Any way. The recon will be an update sheet to log transactions ongoingly, not to be cleared ever...

[mperrah]

Thanks to both of you,
The Parts are updating on the recon and the parts inventory sheet perfectly.
Now Charlize suggeted a search for the receiver, or vlookup.
That sounds great. Not sure where to start for this, also on updating the inventory, the receiver needs to be deleted from the receivers sheet and the blank row removed.
The recon will keep track of where and when it left.
But it needs to be removed from the sheet so it can't be double shipped...
any stabs at this...
Mark

[Charlize]

An alternative to your partslist on the invoice tabs using worksheet change event. When you select an item that already is present, messagebox will popup and will guide you to the quantity column of the already present item. Of course you have to use another list then the one you are using (I used A1 to A34 on the partssheet and changed your datavalidation routines accordinly).Private Sub Worksheet_Change(ByVal Target As Range)
Dim vSearch As String
Dim vParts As Variant
If Target.Row > 5 And Target.Row < 26 And _
Target.Column = 2 Then
Application.EnableEvents = False
If Application.WorksheetFunction.CountIf([B6:B25], Target.Value) > 1 Then
MsgBox "Item already used on another invoice line." & vbCrLf & _
"Cursor will move to that line and add the quantity" & _
" you want.", vbInformation, "Checking input invoice lines ..."
vSearch = Target.Value
Target.ClearContents
With [B6:B25]
Set vParts = .Find(vSearch, LookIn:=xlValues)
vParts.Offset(, 2).Select
End With
End If
Application.EnableEvents = True
End If
End SubThe problem with your receivers, is that you are using formulas that fetch info from the receivers sheet. When you remove the row with receiver model A at the receivers sheet, you get errors on your invoice sheet. I think it is easier to also use a datavalidation on your receivers by modelname (if unique) and use that name to insert the rest of the info at the invoice sheet.

Later, when you make your invoice and print it, you just loop throught the items on the invoice (receivers items) and remove the rows at receivers sheet that match the name on your invoice sheet (from bottom to top). Afterwards you clear the area of the invoice sheet that contains your receivers items.

[mperrah]

Thanks Charlize
I like the msgbox for the duplicates,
I modified it to work on the receivers too.
Still finding a way to delete the receivers when the recon is updated.
I'm using the code you made to clear the contents of the duplicate parts.
I need to keep a portion of the row so just clearing c4 columns will work.
I think if I find the match on the receiver inventory sheet then use offset resize to include the other numbers for the receiver should work.
I used a code taht auto sorts a column on change and moves blankds to the bottom, I'll try to dig it up and show what I got.

Thanks mucho

Mark

[mperrah]

This is what I have so far (not working)
I tried looping through the invoice entries and then the receiver sheet
looking to find a match, and remove it from the receiver sheet

invoice uses column h6:h25
and the receiver sheet match is in column b2 to end of rows.
on the receiver sheet I'm attempting to find the match,
move the focus to column A (-1) then resize 5 col to right and clear...

Sub UpdateRcvrInv()
Dim wsInv As Worksheet, wsRcvr As Worksheet
Dim i As Long, j As Long, lrowInv As Long, lrowRcvr As Long
Dim errornumber As Long
Set wsInv = Worksheets("Invoice")
Set wsRcvr = Worksheets("Receivers")
lrowInv = wsInv.Cells(Rows.Count, 1).End(xlUp).Row
lrowRcvr = wsRcvr.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lrowInv
For j = 1 To lrowRcvr
On Error Resume Next
If Error.Number = 1004 Then
Err.Clear
Else
MsgBox "There is an Error, find and fix"
Exit Sub
End If
If wsInv.Cells(i, 8).Value = wsRcvr.Cells(j, 2) Then
wsRcvr.Cells(i, 2).Offset(0, -1).Resize(0, 5).ClearContents
End If
Next j
Next i

End Sub

Any glaring problems?

[Charlize]

This is for removing the receivers item from the invoice and the receivers tab. And afterwards sorted so that empty line becomes last in receivers sheet (only column A is blank). Are you manually copying column A and B from the receiverssheet to the invoice sheet ?Sub UpdateRec()
'invoice sheet
Dim rng As Range
'receivers sheet
Dim rng2 As Range
'cell on invoice sheet
Dim cell As Range
'cell on receiverssheet
Dim cell2 As Range
Dim sh_start As Worksheet
Dim sh_dest As Worksheet
Set sh_start = Worksheets("Invoice")
Set sh_dest = Worksheets("Receivers")
'If nothing present at invoice sheet on first line
If sh_start.Range("G6") = vbNullString Then Exit Sub
'search on receiverno (unique ?)
Set rng = sh_start.Range("H6:H" & _
sh_start.Range("H" & Rows.Count).End(xlUp).Row)
Set rng2 = sh_dest.Range("B2:B" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row)
'loop for the invoice
For Each cell In rng
'loop for the receiver
For Each cell2 In rng2
If cell.Text = cell2.Text Then
'Remove name of receiver
sh_dest.Range("A" & cell2.Row).ClearContents
Exit For
End If
Next cell2
'remove columns with data and not the formulae
sh_start.Range("G" & cell.Row & ":H" & cell.Row).ClearContents
'continue with next receiver item on invoice
Next cell
'Sort routine to put the empty row at the bottom
'instead of deleting the row to prevent erros
'in invoice sheet
'When you add receivers, do you have to sort again
'to get those lines with empty column A back to the end ?
sh_dest.Range("A1:G200").Sort Key1:=sh_dest.Range("A2"), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End SubAnd you can't delete everything from the receivers sheet. I believe that you are working with named ranges and using offset to find the range of present receivers. Haven't figured out what the problem is, but I know that when I just clear column A, you can add another receiver to the invoice and the other info is found.

How are you adding receivers to the list ? Manually inputting or form ? And is it at the bottom and sorted again to get the empty ones back at the bottom (by scanning ?) ?

Just curious, how did you manage that scan routine of the barcode. I'm very interested in this one ...

[mperrah]

Found this from a post by XLD,
tweaked it to find a match, but it lists the invoice sheet match and I need the receiver sheet match.

Sub appmatch()
With Worksheets("Invoice")
For i = 6 To 25
If Not IsError(Application.Match(.Cells(i, "H").Value, Worksheets("Receivers").Columns(2), 0)) Then
MsgBox "Match found at row" & i
End If
Next i
End With
End Sub

Charlize,
on the invoice I use a barcode reader to scan a receiver as it it is received and the input sheet sends the values to the receiver sheet (adds to inventory.
Then on the invoice sheet we scan the same receiver and the match formulas pull other information to update the invoice.
If the tech is happy with the costs and amounts we print them a copy, and update the recon (to keep on going records of all transactions)
then lastly we update the the parts and receiver inventory sheets based on what the technician leaves with.

we may need to print an invoice without updating inventories or add to the recon archive, so combining all the subs will not be a good fit.

I will test your code (thank you graciously) right now.

The bar cooe reader just enters the text value of what ever you scan.
The input sheet has a cell for each number I need to track.
The barcode is just a special font (3 kinds I've seen) that can use any asci character, in this case just numbers and letters.

I'll try to get the make and model for you.

Thanks again,
Mark

[mperrah]

Charlize,

This code takes out the whole row on the receivers sheet,
but I have formulae that calculate shelf life in col 6 and 7 (F and G)
For Each cell2 In rng2
If cell.Text = cell2.Text Then
'Remove name of receiver
sh_dest.Range("A" & cell2.Row).ClearContents
' sh_dest.Range("A" & cell2).resize(1, 5).ClearContents < something like this??
Exit For
End If
Next cell2

[mperrah]

Thought I'd post this.
It looks like the pieces work.
I just need to finish the interface.
I'm working next on an email warning message. (seperate post)
Thanks again to YLP and Charlize
I'll post the Bar Code info to this Thread when I get it.
:beerchug: :grouphug:

[Charlize]

Charlize,

This code takes out the whole row on the receivers sheet,
but I have formulae that calculate shelf life in col 6 and 7 (F and G)
For Each cell2 In rng2
If cell.Text = cell2.Text Then
'Remove name of receiver
sh_dest.Range("A" & cell2.Row).ClearContents
' sh_dest.Range("A" & cell2).resize(1, 5).ClearContents < something like this??
Exit For
End If
Next cell2sh_dest.Range("A" & cell2.row).resize(0, 4).ClearContentswould be better. Don't want to expand the the offset row. This one means - stay on same row and add 4 columns to the right (ie. total of 5) to clear the contents. Last two columns on receiverssheet are formulae. Do you want to delete those to ?

[mperrah]

Charlize,
I tested the resize(1, 5) and it seems to work
I tried (0, 4) and it gives an error,
I thought resize means the total size of the end product 1x5
not what you are adding (or subtracting)...0x4
I tested on a receiver in the middle of the row, top and bottom,
and it seems to delete and sort just what I need.
Col A to E of match gets cleared,
and blanks get moved to end and sort by received date (col:E).

Now I need to protect the VBA so the user can't mess with it.
I'm going through the cells I want to protect.
How do I Protect the code in 2007 and earlier if different?
Thanks again,
Mark

[mperrah]

Found a glitch,
If there are no parts or no receivers invoiced,
the header gets pasted.
How can I skip the paste step if b6 is empty?

i = 0
For Each cell In sh_source.Range("B6:B" & _
sh_source.Range("B" & Rows.Count).End(xlUp).Row)

With sh_source
.Range("B" & cell.Row).Copy sh_dest.Range("I" _
& sh_dest.Range("I" & Rows.Count).End(xlUp).Row + i)
.Range("C" & cell.Row).Copy sh_dest.Range("J" _
& sh_dest.Range("I" & Rows.Count).End(xlUp).Row)
.Range("D" & cell.Row).Copy sh_dest.Range("K" _
& sh_dest.Range("I" & Rows.Count).End(xlUp).Row)
.Range("E" & cell.Row).Copy sh_dest.Range("L" _
& sh_dest.Range("I" & Rows.Count).End(xlUp).Row)

End With
i = 1
Next cell

[mperrah]

I have this to check for changes.
Any change on the sheet causes it to update.
How can I alter this to scan only cell "F1" for changes?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim checkVal As Range
Dim i As Long
Dim wsParts As Worksheet
Dim wsInvoice As Worksheet

Set wsParts = Worksheets("Parts")
Set wsInvoice = Worksheets("Invoice")
Set checkVal = Range("F1")
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, checkVal) Is Nothing Then

i = 0
For Each cell In wsParts.Range("D1:D34")

If cell.Value < 5 Then
i = i + 1

End If
Next cell

End If
wsParts.Range("F1").Value = "Items Low = " & i
End Sub

[mperrah]

Got placement worked out.
I put a place holder in each row so if no parts or receivers are ordered, "none" is placed in the row of the recon sheet, and the sub moves past to the next section.

Also added a single cell that counts the number of values below 5 for the parts minimum amounts and puts the total into the parts inventory page (the worksheet_change target),
the worksheet_change event catches the value of 1 or more and sends an email with the used cells in the body of the email.
I've attached the "final" version (are they ever Done?)

Thanks Charlize and Doug (YLP)
I meet with the user Tuesday,
I'll let you know what they think and update all on the barcode reader..
Mark:rotlaugh:

[mperrah]

hi Doug and Charlie...
http://www.nextag.com/wws800/search-html

The barcode scanner is by WASP Tech
model wws 800 cr
they range 300 to 500 USD
The docking station plugs into the pc by serial or usb
It uses blue tooth to communicate to the scanner.
Just put the focus on the target cell, scan a barcode and the number (or text)
get pasted into the cell.
After the entry, the focus moves down (or the default direction if different) as if you pressed enter.

My user wants to be able to scan several items without having to touch the computer.
I plan to catch the change of focus to fire a sub, then return the focus to the first entry for the next item to add.

I'll post when I have something working.
Mark

[mperrah]

When the tech has a box that is bad,
we need to show this on the recon sheet.
I tried to modify the code to find the row the match is in and offset the selection and update the values... Not working
It says app or obj defined error
Sub rcvr_Inst_DOA()

Dim rng As Range
Dim rng2 As Range
Dim cell As Range
Dim cell2 As Range
Dim sh_source As Worksheet
Dim sh_dest As Worksheet
Dim i As Long
Dim rcvr As Range

Set sh_source = Worksheets("Input")
Set sh_dest = Worksheets("recon")

'If nothing present at invoice sheet on first line
If sh_source.Range("D19") = vbNullString Then Exit Sub

'search on receiverno (unique ?)
Set rng = sh_source.Range("D19:D" & _
sh_source.Range("D" & Rows.Count).End(xlUp).Row)
Set rng2 = sh_dest.Range("F2:F" & _
sh_dest.Range("F" & Rows.Count).End(xlUp).Row)

'loop for the invoice
For Each cell In rng
'loop for the receiver
For Each cell2 In rng2
If cell.Text = cell2.Text Then
With sh_dest.Columns(6).Rows(cell2)
.Offset(0, 9) = sh_source.[D15] ' Tech Number col(O)
.Offset(0, 10) = sh_source.[D16] ' Cust Name col(P)
.Offset(0, 11) = sh_source.[D17] ' Job Number col(Q)
.Offset(0, 12) = sh_source.[D18] ' Install Date col(R)
.Offset(0, 13) = sh_source.[D19]
End With
Exit For
End If
Next cell2
Next cell
End Sub
Any ideas?
Mark

[mperrah]

Fixed the installed receiver issues.
Now I am trying to get the line with the invoice to be copied down on the recon sheet
I have a sheet that reconciles all the invoices.
Each invoice has up to 20 line items
I need the first three items [J2,J3,B3] of the invoice to copy down the recon the number of rows that are used on the invoice.
if 5 parts are invoiced and 2 receivers, the values in J2,J3,B3 needs to copy down 5 rows on the recon sheet.

the commented code below is my attempt...

Sub AddToRecon()
Dim sh_source As Worksheet
Dim sh_dest As Worksheet
Dim cell As Range
Dim i As Long
Dim c As Long
Dim myRng1 As Long
Dim myRng2 As Long
Dim iEnd As Long
Dim lastr As Long
Dim lrE As Long
Dim lrI As Long

Set sh_source = Worksheets("Invoice")
Set sh_dest = Worksheets("recon")

sh_dest.Select

With sh_dest
lrE = Cells(Rows.Count, "D").End(xlUp).Row
lrI = Cells(Rows.Count, "H").End(xlUp).Row
If lrE > lrI Then
lastr = lrE
ElseIf lrI > lrE Then
lastr = lrI
ElseIf lrE = lrI Then
lastr = lrE
End If
End With

' ' see how far down to copy invoice range
' With sh_source
' myRng1 = Cells(Rows.Count, "D").End(xlUp).Row
' myRng2 = Cells(Rows.Count, "G").End(xlUp).Row
' End With
'
' With sh_source
' If myRng1 > myRng2 Then
' iEnd = myRng1
' ElseIf myRng1 < myRng2 Then
' iEnd = myRng2
' ElseIf myRng1 = myRng2 Then
' iEnd = myRng1
' End If
' End With
'
' For c = 1 To iEnd
' On Error Resume Next
' With sh_dest.Columns(1).Rows(lastr)
' .Offset(0, 0) = sh_source.[J3] ' invoice number
' .Offset(0, 1) = sh_source.[J2].Text ' Date
' .Offset(0, 2) = sh_source.[B3] ' Tech
' End With
' Next c
With sh_dest.Columns(1).Rows(lastr)
.Offset(1, 0) = sh_source.[J3] ' invoice number
.Offset(1, 1) = sh_source.[J2].Text ' Date
.Offset(1, 2) = sh_source.[B3] ' Tech
.Offset(1, 3) = sh_source.[F6] ' space locator for rcvr
.Offset(1, 7) = sh_source.[F7] ' space locator for PARTS
.Offset(1, 11) = sh_source.[E27] ' Total cost
End With

' start Receiver recon update
If Worksheets("Invoice").Range("G6") = "" Then
GoTo exitRcvrAdd
End If

i = 0

For Each cell In sh_source.Range("G6:G" & _
sh_source.Range("G" & Rows.Count).End(xlUp).Row)
With sh_source
.Range("G" & cell.Row).Copy sh_dest.Range("D" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row + i)
.Range("H" & cell.Row).Copy sh_dest.Range("E" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
.Range("I" & cell.Row).Copy sh_dest.Range("F" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
.Range("J" & cell.Row).Copy sh_dest.Range("G" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
.Range("F" & cell.Row).Copy sh_dest.Range("H" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
End With
i = 1
Next cell

exitRcvrAdd:

' start parts recon update
If Worksheets("Invoice").Range("D6") = "" Then
GoTo exitPartsAdd
End If

i = 0
For Each cell In sh_source.Range("B6:B" & _
sh_source.Range("B" & Rows.Count).End(xlUp).Row)
With sh_source
.Range("B" & cell.Row).Copy sh_dest.Range("H" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row + i)
.Range("C" & cell.Row).Copy sh_dest.Range("I" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
.Range("D" & cell.Row).Copy sh_dest.Range("J" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
.Range("E" & cell.Row).Copy sh_dest.Range("K" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
End With
i = 1
Next cell
exitPartsAdd:

Call delBorder
Call makevalues
Call RemParts
Call RemRcvr
Call NewInvoice
With Worksheets("Parts").Columns(8).Rows(2)
.Value = Now()
End With

With Worksheets("Receivers").Columns(8).Rows(2)
.Value = Now()
End With
End Sub

any takers?
Thank you in advance...
Mark

[Charlize]

To know the no of times you must copy [J2,J3,B3] just count the last no in column B (parts) and column G (receiver). From those two numbers you take the one which is the greatest. Then substract 5 from it (start of the rowheading) and you've got the no of times you need to copy [J2,J3,B3].
ie. parts lastrow = 10, receiver lastrow = 7
- we take 10 - 5 = 5 times to copy down
ie. parts lastrow = 6, receiver lastrow = 8
- we take 8 - 5 = 3 times to copy down

Or am I missing the point of your answer.

ps.: Btw thanks for the info about the scanner. But I'm experimenting with my webcam and some software (which I don't get to work yet) to import barcodeno into an application. There is an online site that uses a webcam to lookup items and display them but I can't get the barcode no from that site into my excel file (yet).

[mperrah]

wonder if ocr program might help for the barcode.
If the image from the web gets sent through optical character recognition, a barcode might be able to be retreived?

In regards to the number,
where do I tell the offset portion to iterate the length
and why minus 5?

[mperrah]

This only copies down 2 rows.
Not sure what I'm missing...

Sub AddToRecon()
Dim sh_source As Worksheet
Dim sh_dest As Worksheet
Dim cell As Range
Dim i As Long
Dim c As Long
Dim myRng1 As Long
Dim myRng2 As Long
Dim iEnd As Long
Dim lastr As Long
Dim lrE As Long
Dim lrI As Long

Set sh_source = Worksheets("Invoice")
Set sh_dest = Worksheets("recon")

sh_dest.Select

With sh_dest
lrE = Cells(Rows.Count, "D").End(xlUp).Row
lrI = Cells(Rows.Count, "H").End(xlUp).Row
If lrE > lrI Then
lastr = lrE
ElseIf lrI > lrE Then
lastr = lrI
ElseIf lrE = lrI Then
lastr = lrE
End If
End With

' see how far down to copy invoice range
With sh_source
myRng1 = Cells(Rows.Count, "B").End(xlUp).Row - 5
myRng2 = Cells(Rows.Count, "G").End(xlUp).Row - 5
End With
With sh_source
If myRng1 > myRng2 Then
iEnd = myRng1
ElseIf myRng1 < myRng2 Then
iEnd = myRng2
ElseIf myRng1 = myRng2 Then
iEnd = myRng1
End If
End With
i = 0
For c = 1 To iEnd
On Error Resume Next
With sh_dest.Columns(1).Rows(lastr + i)
.Offset(1, 0) = sh_source.[J3] ' invoice number
.Offset(1, 1) = sh_source.[J2].Text ' Date
.Offset(1, 2) = sh_source.[B3] ' Tech
End With
i = 1
Next c
With sh_dest.Columns(1).Rows(lastr)
' .Offset(1, 0) = sh_source.[J3] ' invoice number
' .Offset(1, 1) = sh_source.[J2].Text ' Date
' .Offset(1, 2) = sh_source.[B3] ' Tech
.Offset(1, 3) = sh_source.[F6] ' space locator for rcvr
.Offset(1, 7) = sh_source.[F7] ' space locator for PARTS
.Offset(1, 11) = sh_source.[E27] ' Total cost
End With

' start Receiver recon update
If Worksheets("Invoice").Range("G6") = "" Then
GoTo exitRcvrAdd
End If

i = 0

For Each cell In sh_source.Range("G6:G" & _
sh_source.Range("G" & Rows.Count).End(xlUp).Row)
With sh_source
.Range("G" & cell.Row).Copy sh_dest.Range("D" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row + i)
.Range("H" & cell.Row).Copy sh_dest.Range("E" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
.Range("I" & cell.Row).Copy sh_dest.Range("F" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
.Range("J" & cell.Row).Copy sh_dest.Range("G" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
.Range("F" & cell.Row).Copy sh_dest.Range("H" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
End With
i = 1
Next cell

exitRcvrAdd:

' start parts recon update
If Worksheets("Invoice").Range("D6") = "" Then
GoTo exitPartsAdd
End If

i = 0
For Each cell In sh_source.Range("B6:B" & _
sh_source.Range("B" & Rows.Count).End(xlUp).Row)
With sh_source
.Range("B" & cell.Row).Copy sh_dest.Range("H" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row + i)
.Range("C" & cell.Row).Copy sh_dest.Range("I" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
.Range("D" & cell.Row).Copy sh_dest.Range("J" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
.Range("E" & cell.Row).Copy sh_dest.Range("K" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
End With
i = 1
Next cell
exitPartsAdd:

Call delBorder
Call makevalues
Call RemParts
Call RemRcvr
Call NewInvoice
With Worksheets("Parts").Columns(8).Rows(2)
.Value = Now()
End With

With Worksheets("Receivers").Columns(8).Rows(2)
.Value = Now()
End With
End Sub

[mperrah]

With sh_source

myRng1 = 20 - Range("D6:D25").SpecialCells(xlCellTypeBlanks).Count
myRng2 = 20 - Range("G6:G25").SpecialCells(xlCellTypeBlanks).Count
End With
With sh_source
If myRng1 > myRng2 Then
iEnd = myRng1 - 5
ElseIf myRng1 < myRng2 Then
iEnd = myRng2 - 5
ElseIf myRng1 = myRng2 Then
iEnd = myRng1 - 5
End If
End With
i = 0
For c = 1 To iEnd
' On Error Resume Next
With sh_dest.Columns(1).Rows(lastr + i)
.Offset(1, 0) = sh_source.[J3] ' invoice number
.Offset(1, 1) = sh_source.[J2].Text ' Date
.Offset(1, 2) = sh_source.[B3] ' Tech
End With
i = i + 1
Next c

[Charlize]

In regards to the number,
where do I tell the offset portion to iterate the length
and why minus 5?
For I = 1 to Lrow
.offset(1,3) ...
Next I
Lrow is the last line of your invoice to be processed - 5

The minus 5 because your first invoice line is at 6 --- so 6 - 5 means you have to copy those 3 cells 1 time.

and the offset is always 1 when you use an With End With construction for you invoice log.

[mperrah]

I got the bugs worked out,
Thanks Charlize (and Doug)
The code is not the prettiest, but hey, it's invisible to the user any way when it works....

I was having a hard time getting the used cells on the invoice counted properly and came up with this three step proccess, thanks to an idea I got from charlize.

After getting these to wok I was thinking down the road when the user might add more parts to the parts list.
My drop down for the invoice is allready dynamic, but I use formulae to get the onhand amount into the drop down.
To keep the list sorted correctly I only type the formula on the used rows.
If I were to add a sub to allow new parts to be added from the input sheet, if the match test to add quantities to existing parts finds no match, I could add an if statement to paste a formula along with the data ?
Right now adding an item not in the drop down Validation causes a break

I'll search the KB for something close.
Here is the working part to update the recon sheet,
I'll post the book too.

Sub AddToRecon()
Dim sh_source As Worksheet
Dim sh_dest As Worksheet
Dim cell As Range
Dim i As Long
Dim c As Long
Dim lastr As Long
Dim lrD As Long
Dim lrH As Long
Dim p As Double
Dim r As Double
Dim invct As Double

Set sh_source = Worksheets("Invoice")
Set sh_dest = Worksheets("recon")

sh_dest.Select

With sh_dest
lrD = Cells(Rows.Count, "D").End(xlUp).Row
lrH = Cells(Rows.Count, "H").End(xlUp).Row
If lrD > lrH Then
lastr = lrD
ElseIf lrH > lrD Then
lastr = lrH
ElseIf lrD = lrH Then
lastr = lrD
End If
End With

' see how far down to copy invoice range
p = 0
With sh_source
For i = 6 To 25
If .Range("B" & i).Value = "" Then
' do nothing or exit with...
Else
p = p + 1
End If
Next i
End With

r = 0
With sh_source
For i = 6 To 25
If .Range("G" & i).Value = "" Then
' do nothing or exit with...
Else
r = r + 1
End If
Next i
End With

invct = 0
If r > p Then
invct = r
ElseIf p > r Then
invct = p
ElseIf p = r Then
invct = p
End If

i = 0
For c = 1 To invct
' On Error Resume Next
With sh_dest.Columns(1).Rows(lastr + i)
.Offset(1, 0) = sh_source.[J3] ' invoice number
.Offset(1, 1) = sh_source.[J2].Text ' Date
.Offset(1, 2) = sh_source.[B3] ' Tech
End With
i = i + 1
Next c
With sh_dest.Columns(1).Rows(lastr)
.Offset(1, 3) = sh_source.[F6] ' space locator for rcvr
.Offset(1, 7) = sh_source.[F7] ' space locator for PARTS
.Offset(1, 11) = sh_source.[E27] ' Total cost
End With

' start Receiver recon update
If Worksheets("Invoice").Range("G6") = "" Then
GoTo exitRcvrAdd
End If

i = 0

For Each cell In sh_source.Range("G6:G" & _
sh_source.Range("G" & Rows.Count).End(xlUp).Row)
With sh_source
.Range("G" & cell.Row).Copy sh_dest.Range("D" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row + i)
.Range("H" & cell.Row).Copy sh_dest.Range("E" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
.Range("I" & cell.Row).Copy sh_dest.Range("F" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
.Range("J" & cell.Row).Copy sh_dest.Range("G" _
& sh_dest.Range("D" & Rows.Count).End(xlUp).Row)
End With
i = 1
Next cell

exitRcvrAdd:

' start parts recon update
If Worksheets("Invoice").Range("D6") = "" Then
GoTo exitPartsAdd
End If

i = 0
For Each cell In sh_source.Range("B6:B" & _
sh_source.Range("B" & Rows.Count).End(xlUp).Row)
With sh_source
.Range("B" & cell.Row).Copy sh_dest.Range("H" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row + i)
.Range("C" & cell.Row).Copy sh_dest.Range("I" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
.Range("D" & cell.Row).Copy sh_dest.Range("J" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
.Range("E" & cell.Row).Copy sh_dest.Range("K" _
& sh_dest.Range("H" & Rows.Count).End(xlUp).Row)
End With
i = 1
Next cell
exitPartsAdd:
Call delBorder
Call makevalues
Call RemParts
Call RemRcvr
Call NewInvoice
With Worksheets("Parts").Columns(8).Rows(2)
.Value = Now()
End With

With Worksheets("Receivers").Columns(8).Rows(2)
.Value = Now()
End With
End Sub

[mperrah]

This is in a regular module
Sub AddPartLowFormula()
Range("E1").Formula = "=IF(D1<5,IF(D1<=0,""OUT"",""Low""),"""")"
Range("prtLow").FillDown
End Sub
Sub AddPartFormula()
Dim lrowPart As Long

Worksheets("Parts").Activate

With Worksheets("Parts")
lrowPart = .Cells(Rows.Count, 2).End(xlUp).Row
Range("A1").Formula = "=if(B1="""","""",B1&"" - ""&D1)"
Range("A1:A" & lrowPart).FillDown
End With
End Sub


This goes in the "Parts" worksheet code
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim partsAdded As Range

Set partsAdded = Range("B:B")

If Target.Column = 2 Then
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, partsAdded) Is Nothing Then

Call AddPartFormula
Call AddPartLowFormula

End If
End If
End Sub

I used a named range for one sub and an autoscan for lastrow on the other. both work fine...

I need to make the formula delete now if a part is removed,
but I'll figure that out. Thanks again to all.
Hope this helps someone too.
Mark