Compare master list and update

[annysjunkmail]

I have done a lot searching on this Group but can't find a routine to
meet my needs.

I have 2 worksheets, Inventory and Parts. Parts is updated weekly and
inventory is my master list. I wish to compare PartID in Col A on
'Parts' to PartID in Col B on 'Inventory' see if new entries exist and,
if they do, add these new PartID's to my inventory.

I have found 2 routines that may be useful, one which checks and finds
new PartID's and another routine which inserts rows and copies and
pastes required formulas. Is is possible for someone to 'join' these 2
routines together to achieve what I need?

Many thanks
Tony

'Routine 1
Sub CheckForNewParts()
Dim rng1 As Range
Dim rng2 As Range
Dim rw As Long
Dim cell As Range


'Set the range. Start at A2
Set rng1 = Range(Cells(2, 1), _
Cells(Rows.Count, 1).End(xlUp))

'Set the range for the Inventory database. Start at B2
With Worksheets("Inventory")
Set rng2 = .Range(.Cells(2, "B"), .Cells(Rows.Count,
"B").End(xlUp))
End With
rw = 2

'Compare columns. If new parts are found add to col L...
For Each cell In rng1

If Application.CountIf(rng2, cell.Value) = 0 Then
Cells(rw, 12).Value = cell.Value
rw = rw + 1
'Else
''
End If
Next
End Sub

'Routine 2
Sub InsertRows()
Dim VRows As Long
' Documented: http://www.mvps.org/dmcritchie/excel/insrtrow.htm
' Re: Insert Rows -- 1997/09/24 Mark Hill
'Dim vRows As Integer
' row selection based on active cell -- rev. 2000-09-02 David
McRitchie
ActiveCell.EntireRow.Select 'So you do not have to preselect entire
row
VRows = 1
If VRows <> 1 Then
VRows = Application.InputBox(prompt:= _
"How many rows do you want to add?", Title:="Add Rows", _
Default:=1, Type:=1) 'type 1 is number
If VRows = False Then Exit Sub
End If

'if you just want to add cells and not entire rows
'then delete ".EntireRow" in the following line

'rev. 20001-01-17 Gary L. Brown, programming, Grouped sheets
Dim sht As Worksheet, shts() As String, i As Integer
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name

Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=VRows).Insert Shift:=xlDown

Selection.AutoFill Selection.Resize( _
rowsize:=VRows + 1), xlFillDefault


On Error Resume Next 'to handle no constants in range -- John
McKee 2000/02/01
' to remove the non-formulas -- 1998/03/11 Bill Manville
Selection.Offset(1).Resize(VRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select

End Sub

 

[Tom Ogilvy]

'Routine 1
Sub CheckForNewParts()
Dim rng1 As Range
Dim rng2 As Range
Dim rw As Long
Dim cell As Range


'Set the range. Start at A2
with Worksheets("Parts")
Set rng1 = .Range(.Cells(2, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End with

'Set the range for the Inventory database. Start at B2
With Worksheets("Inventory")
Set rng2 = .Range(.Cells(2, "B"), .Cells(Rows.Count,
"B").End(xlUp))
End With
rw = rng2.rows(rng2.rows.count).row + 1

'Compare columns. If new parts are found add to
' the bottom of Inventory
For Each cell In rng1

If Application.CountIf(rng2, cell.Value) = 0 Then
cell.Resize(1,10).copy Destination:=rng2.parent.Cells(rw,2)
rw = rw + 1
set rng2 = rng2.Resize(rng2.rows.count+1,1)
End If
Next
End Sub

You don't provide any details on what you want to copy or where it should
go, so I copy A:J of the new row and paste it into the bottom of Inventory
starting in column B.

 

[annysjunkmail]

Worked a treat,
Thank you once again Tom

Tony