mperrah
10-25-2007, 12:10 PM
I'm trying to update 2 sheets with find and match and offset,
depending on several options...
I have a sub to add the receivers to inventory
"inventory" is worksheet("Receivers")
I invoice them out to remove them from inventory.
if the receiver is not used, it gets returned to inventory.
Sometimes though a receiver might go to another tech,
not back to inventory.
I have 5 rows of in a static location on Worksheets("Input")
3 cells are data validation
I14 is the tech from, I15 is the location to (tech or warehouse)
I16 is the reason, I17 is the Date
Rows I18 to I28 are items that will transfer (receivers)
If I15 = "1000 warehouse" then the items need to get added to the receiver sheet so it can be re-invoiced later
The number scanned will need to pull 3 other numbers from the recon sheet to re-populate the "Receiver" sheet
if the the value is anything other than "1000 Warehouse"
it needs to modify the offset of the match item I18 to I28 found on worksheets("Recon") rows D2 to end.
This is how I add receivers...
Sub AddRcvr()
Dim rcvrWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
myCopy = "D7,D8,D9,D6"
Set inputWks = Worksheets("Input")
Set rcvrWks = Worksheets("Receivers")
With rcvrWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range(myCopy)
If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With rcvrWks
oCol = 1
For Each myCell In myRng.Cells
rcvrWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
'clear input cells that contain constants
With Sheets("Input")
[D7, D8, D9].ClearContents
[D7].Select
End With
End Sub
This is how I modify the "Recon" sheet if a receiver is DOA or installed:
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("D18") = vbNullString Then Exit Sub
'search on receiverno (unique ?)
Set rng = sh_source.Range("D18:D" & _
sh_source.Range("D" & Rows.Count).End(xlUp).Row)
Set rng2 = sh_dest.Range("D2:D" & _
sh_dest.Range("D" & 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.Range("D" & cell2.Row)
.Offset(0, 10) = sh_source.[D14] ' Tech Number col(O)
.Offset(0, 11) = sh_source.[D15] ' Cust Name col(P)
.Offset(0, 12) = sh_source.[D16] ' Job Number col(Q)
.Offset(0, 13) = sh_source.[D17] ' Install Date col(R)
End With
Exit For
End If
Next cell2
Next cell
With Worksheets("Input")
[D14:D28].ClearContents
[D14].Select
End With
End Sub
This is how I remove the parts with an Invoice:
Sub RemRcvr()
Dim rng As Range
Dim rng2 As Range
Dim cell As Range
Dim cell2 As Range
Dim sh_start As Worksheet
Dim sh_dest As Worksheet
Dim i As Long
Dim rcvr As Range
Dim r As Double
Dim lrowRcvr As Long
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("G6:G" & _
sh_start.Range("G" & Rows.Count).End(xlUp).Row)
Set rng2 = sh_dest.Range("A2:A" & _
sh_dest.Range("A" & 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
sh_dest.Range("A" & cell2.Row).Resize(1, 4).ClearContents
Exit For
End If
Next cell2
Next cell
lrowRcvr = sh_dest.Cells(Rows.Count, 1).End(xlUp).Row
sh_dest.Range("A2:F" & lrowRcvr).Sort Key1:=sh_dest.Range("D2"), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
r = 0
With sh_dest
For i = 2 To lrowRcvr
If .Range("F" & i).Value = "" Then
ElseIf .Range("F" & i).Value > 0 And .Range("F" & i).Value < 16 Then
r = r + 1
ElseIf .Range("F" & i).Value >= 16 Then
End If
Next i
End With
With Worksheets("Receivers").Columns(8).Rows(1)
.Value = r
End With
End Sub
I need to do parts of each of these in one step.
1. Check if the receiver goes to stock or to a tech
2. If to stock, get the 3 numbers to the right of the match on the "Recon" sheet, and copy them to "Receivers"
3. If to tech, Find the match on "Recon" and add the cells to the offset, like the Installed or DOA sub does.
Any help would be appreciated...
Thanks in advance.
Mark
depending on several options...
I have a sub to add the receivers to inventory
"inventory" is worksheet("Receivers")
I invoice them out to remove them from inventory.
if the receiver is not used, it gets returned to inventory.
Sometimes though a receiver might go to another tech,
not back to inventory.
I have 5 rows of in a static location on Worksheets("Input")
3 cells are data validation
I14 is the tech from, I15 is the location to (tech or warehouse)
I16 is the reason, I17 is the Date
Rows I18 to I28 are items that will transfer (receivers)
If I15 = "1000 warehouse" then the items need to get added to the receiver sheet so it can be re-invoiced later
The number scanned will need to pull 3 other numbers from the recon sheet to re-populate the "Receiver" sheet
if the the value is anything other than "1000 Warehouse"
it needs to modify the offset of the match item I18 to I28 found on worksheets("Recon") rows D2 to end.
This is how I add receivers...
Sub AddRcvr()
Dim rcvrWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
myCopy = "D7,D8,D9,D6"
Set inputWks = Worksheets("Input")
Set rcvrWks = Worksheets("Receivers")
With rcvrWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range(myCopy)
If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With rcvrWks
oCol = 1
For Each myCell In myRng.Cells
rcvrWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
'clear input cells that contain constants
With Sheets("Input")
[D7, D8, D9].ClearContents
[D7].Select
End With
End Sub
This is how I modify the "Recon" sheet if a receiver is DOA or installed:
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("D18") = vbNullString Then Exit Sub
'search on receiverno (unique ?)
Set rng = sh_source.Range("D18:D" & _
sh_source.Range("D" & Rows.Count).End(xlUp).Row)
Set rng2 = sh_dest.Range("D2:D" & _
sh_dest.Range("D" & 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.Range("D" & cell2.Row)
.Offset(0, 10) = sh_source.[D14] ' Tech Number col(O)
.Offset(0, 11) = sh_source.[D15] ' Cust Name col(P)
.Offset(0, 12) = sh_source.[D16] ' Job Number col(Q)
.Offset(0, 13) = sh_source.[D17] ' Install Date col(R)
End With
Exit For
End If
Next cell2
Next cell
With Worksheets("Input")
[D14:D28].ClearContents
[D14].Select
End With
End Sub
This is how I remove the parts with an Invoice:
Sub RemRcvr()
Dim rng As Range
Dim rng2 As Range
Dim cell As Range
Dim cell2 As Range
Dim sh_start As Worksheet
Dim sh_dest As Worksheet
Dim i As Long
Dim rcvr As Range
Dim r As Double
Dim lrowRcvr As Long
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("G6:G" & _
sh_start.Range("G" & Rows.Count).End(xlUp).Row)
Set rng2 = sh_dest.Range("A2:A" & _
sh_dest.Range("A" & 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
sh_dest.Range("A" & cell2.Row).Resize(1, 4).ClearContents
Exit For
End If
Next cell2
Next cell
lrowRcvr = sh_dest.Cells(Rows.Count, 1).End(xlUp).Row
sh_dest.Range("A2:F" & lrowRcvr).Sort Key1:=sh_dest.Range("D2"), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
r = 0
With sh_dest
For i = 2 To lrowRcvr
If .Range("F" & i).Value = "" Then
ElseIf .Range("F" & i).Value > 0 And .Range("F" & i).Value < 16 Then
r = r + 1
ElseIf .Range("F" & i).Value >= 16 Then
End If
Next i
End With
With Worksheets("Receivers").Columns(8).Rows(1)
.Value = r
End With
End Sub
I need to do parts of each of these in one step.
1. Check if the receiver goes to stock or to a tech
2. If to stock, get the 3 numbers to the right of the match on the "Recon" sheet, and copy them to "Receivers"
3. If to tech, Find the match on "Recon" and add the cells to the offset, like the Installed or DOA sub does.
Any help would be appreciated...
Thanks in advance.
Mark