Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Compare master list and update
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 ' 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).SelectedShee ts 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Compare master list and update
'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. -- Regards, Tom Ogilvy wrote in message ups.com... 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 ' 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).SelectedShee ts 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Compare master list and update
Worked a treat,
Thank you once again Tom Tony |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to update a date in a Master List using daily list | Excel Discussion (Misc queries) | |||
Compare City and State to Master List | Excel Worksheet Functions | |||
Update master list with other lists | Excel Worksheet Functions | |||
Compare Master Account List with Partner Accounts | Excel Programming | |||
Master List Losing Record Due to Update from Links | New Users to Excel |