+ Reply to Thread
Results 1 to 3 of 3

Compare master list and update

  1. #1

    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
    ' 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


  2. #2
    Tom Ogilvy
    Guest

    Re: 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


    <[email protected]> wrote in message
    news:[email protected]...
    > 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
    >




  3. #3

    Re: Compare master list and update

    Worked a treat,
    Thank you once again Tom

    Tony


+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1